Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/README
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/README	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/README	(revision 46)
@@ -0,0 +1,402 @@
+== 17/09/08 ==
+>>> Build a version with new soil but old radiative transfer,
+    but keeping possibility of switching back to new radiative transfer),
+    which incorporates changes & improvements currently included in the
+    'reference version' GCM (see /u/emlmd/LMDZ.MARS.mixdyn)
+
+>>> start by modifying makegcm as in /u/emlmd/LMDZ.MARS.mixdyn, so that it runs
+    without environment variables and set LIBOGCM to /tmp15/emlmd/libo
+
+>>> directory contents of 'aeronomars', 'grid' and 'filtrez' are simillar
+    to those in /u/emlmd/LMDZ.MARS.mixdyn
+
+>>> in bibio , only file mxva.F needed be upgraded
+
+>>> get phymars and dyn3d contents from /u/emlmd/LMDZ.MARS.mixdyn
+    (and remove all *old files)
+
+>>> check differences between dyn3d and /u/emlmd/LMDZ.MARS.170908/libf/dyn3d
+    and upgrade when necessary:
+    - removed 'netcdf.inc' file (has nothing to do there!)
+    - comgeom.h and comgeom.h : made fortran90 compliant
+    - control.h : made fortran90 compliant
+    - dynredem.F : more read/write controls + comments in english
+    - ini_archive.F : new soil/thermal inertia changes
+    - integrd.F : added additional information to output when crashing
+    - lect_start_archive.F : new soil/thermal inertia changes
+    - newstart.F : new soil/thermal inertia changes + comments in english
+    - start2archive.F : new soil/thermal inertia changes
+    - vanleer.F : removed inapropriate 'external' statement
+    - write_archive.F : enable writting a subterranean field
+
+>>> check differences between phymars and /u/emlmd/LMDZ.MARS.170908/libf/phymars
+    and upgrade when necessary:
+    New soil stuff:
+    - added comsoil.h
+    - iniwrite.F : new soil changes
+    - added iniwritesoil.F90 and writediagsoil.F90 for subterranean fields
+    - added interp_line.F (for subterranean grid interpolation)
+    - adapted phyetat0.F for subterranean temperature & inertia
+    - adapted physdem1.F to include new soil stuff
+    - physiq.F : added calls to writediagsoil 
+    - soil.F : new routine (fixed vertical grid + variable thermal inertia)
+    - added soil_settings.F (to read/initialize/interpolate soil properties)
+    - updated surfdat.h (since thermal inertia is now in comsoil.h)
+    - updated tabfi.F : include new soil properties
+    - updated testphys1d.F
+    - updated dimphys.h (set nsoil=18 as default)
+
+== 18/09/08 ==
+>>> add the possibility of easily switching to Tran radiative transfert
+    - updated aerdust.h.ocke97 (changed some variables name) so it can
+      replace aerdust.h (which is currently the same as aerdust.h.clan91).
+    - imported Tran's 'gfluxv.F' routine
+    - imported Trans' version of 'swr.F' routine, saved it as 'swr.F.toon'
+
+>>> Backup of 'old' Morcrette swr.F is 'swr.F.morc'
+    NB: to switch from one radiative transfer to the other, just copy
+    swr.F.morc or swr.F.toon to swr.F (and eventually 'touch swr.F' so that
+    makegcm recompiles swr.F)
+    No other dependencies (swr.F.toon uses 'gfluxv.F' and swr.F.morc uses
+    'dedd.F').
+
+>>> Changed the latter, so that users can switch from one to the other
+    - modified swr.F.toon to become swr_toon.F (and to include gfluxv.F)
+    - modified swr.F.morc to become swr_fouquart.F (and to include dedd.F)
+    - added a flag in callkeys.h, swrtype (parameter to be set/changed by
+      the user 1=Fouquart and 2=Toon)
+    - update readtesassim so that the coefficient by which opacity
+      is multiplied is set according to the 'swrtype' parameter
+
+== 25/09/08 ==
+>>> Implement the use of tracer-by-name in physics
+    - in phymars/tracer.h set 'noms' length to 20 (instead of 10)
+    - in phymars/callsedim2q.F and phymars/callsedim.F, use tracers by name
+    - in phymars/dustopacity.F, use tracers by name
+    - in phymars/vdifc.F, use tracers by name
+
+== 26/09/08 ==
+>>> Change implementation strategy (for now); don't move surface tracer around
+    i.e.: surface ice remains equivalent to qsurf(nqmx)=qsurf(i_h2o_vap)
+          and likewise for surface tendencies ...
+    - modified vdifc.F and callsedim.F back
+    - modified initracer.F (so that water names are h2o_vap & h2o_ice)
+    
+== 29/09/08 ==
+    - modified aeronomars/init_chimie_B (cosmetics)
+    - corrected aeronomars/moldiff.F internal routine tridag; changed
+      "pause" error messages to 'stop' messages
+    - modified phymars/watercloud.F to use tracers by name
+    - corrected aeronomars/molvis.F (undefined 'fac' and 'Akk' written to 
+       output at first call)
+    
+== 30/09/08 ==
+    - modified aeronomars/calchim.F to use tracers by name
+    - adapted aeronomars/photochemist_B.F to use tracers by name
+    - adapted aeronomars/chemtermos.F to use tracers by name
+    - adapted aeronomars/concentrations.F to use tracers by name
+    - corrected aeronomars/conduction.F (undefined 'Akk' written to output
+      at first call)
+    - adapted aeronomars/euvheat.F to use tracers by name
+    - adapted aeronomars/moldiff.F and moldiffcoeff.F to use tracers by name
+
+== 01/10/08 ==
+    - For more compatibility with LMDZ4; mimic reading a 'traceur.def' file
+      in the dynamics via a call to a routine 'iniadvtrac.F' and saving
+      tracers names in 'advtrac.h'
+     -> created 'iniadvtrac.F', 'advtrac.h' and modified gcm.F
+    - modified 'dynetat0.F' so that tracers are loaded from 'start.nc' by name
+    - modified 'dynredem.F' so that tracers are written to 'restart.nc'
+      by name
+    - modified 'initracer.F' tu use tracers by name
+
+== 02/10/08 ==
+    - removed use of 'nqchem_min' everywhere:
+      adapted 'euvheat.F','inifis.F','physiq.F'
+      (leave 'inichim.F' for later)
+    - updated 'phyetat0' and 'physdem1.F' to read/write surface tracers by name
+    - modify things so that surface water ice index is the same as
+      atmospheric water ice (except when running without water ice; then
+      simply set i_h2o_ice=i_h2o_vap).
+      NB: the easiest is to have global storage of tracer names/indexes in
+      tracer.h
+      => changed initracer.F & tracer.h to have global igcm_something indexes
+
+== 03/10/08 ==
+    - adaptations for surface ice index, modified files:
+      phyetat0.F : if there is a dynamical tracer 'h2o_vap' then load
+                   surface tracer called 'h2o_ice' instead
+      initracer.F : in 'old' tracer name case: move qsurf(nqmx)->qsurf(nqmx-1)
+                    and set i_h2o_ice=i_h2o_vap if iceparty=.false.
+      physdem1.F : if old tracer names: move qsurf(nqmx-1)->qsurf(nqmx)
+                   if iceparty=.false., write surface tracer 'h2o_ice'
+                   (and not 'h2o_vap') to file.
+      adapted vdifc.F, callsedim.F & watercloud.F & physiq.F so that surface
+      ice is now identified as qsurf(i_h2o_ice)
+    - updated aeronomars/perosat.F (cosmetics)
+
+== 06/10/08 ==
+    - modify newstart.F and lect_start_archive.F to use tracers by name
+== 07/10/08 ==
+    - adapted inichim_newstart.F (added qsurf to arguments)
+      and inichim_readcallphys.F
+== 08/10/08 ==
+    - implement reading traceur.def in dyn3d/iniadvtrac.F
+
+== 16/10/08==
+    -small change in inifis.F (only warn if too many tracers, compared
+     to the expected number, not stop).
+     - corrected bug in initracer.F
+== 21/10/08 ==
+    - modified newstart.F to load B.Diez subsurface ice maps.
+    - corrected small bug (uninitialized variable) in interp_horiz.F
+== 22/10/08 ==
+    - updated iniwritediagsoil.F so that thermal inertia is written to
+      diagsoil.nc
+== 31/10/08 ==
+    - changed xvik.F program so it works even if we don't have atmospheric
+     temperature at hand (then it uses a 10km reference scale height) and so
+     that it does surface pressure interpolation log-wise.
+== 03/11/08 ==
+    - modified physiq to compute (and output) co2 column.
+    - added improvement by Francois in newcondens.F about computing CO2
+      partial pressure. This behavior is turned on by setting internal logical
+      flag 'improved_ztcond' to '.true.' (and running with a co2 tracer)
+    - updated 'start2archive' to work with 'new' gcm output (soil, tracers ...)
+== 04/11/08 ==
+    - upgraded xvik program to look for temperature in 7th layer variable if
+     there is no global atmospheric temperature field at hand.
+== 05/11/08 ==
+    - more modifs to newcondens.F: added another internal flag 'bound_qco2' to
+     enforce (if set to .true.) that co2 mass mixing ratio remains bounded.
+== 07/11/08 ==
+    - corrected 'writediagfi' & 'writediagsoil' so that an error message is 
+      issued if called with a variable name which is too long.
+== 18/12/08 ==
+    - corrected bug in dyn3d 'addfi.F', (dimensions of local array p())
+== 23/02/09 ==
+    - modified "aeronomars/param_read.F" to do strictly fortran data
+     initialization (otherwise xlf compiler complains)
+    - changed a few '1.e-30' to '1.d-30' in aeronomars/photochemist_B.F
+     so that max functions has 2 doubles as arguments (otherwise xlf
+     compiler complains)
+
+==07/04/09 ==
+    -cosmetic changes/minor improvements in the handling of tracers in:
+     aeronomars/photochemist_B.F
+     aeronomars/perosat.F
+     aeronomoars/euvheat.F
+     aeronomars/moldiffcoeff.F
+     aeronomars/moldiff.F
+     aeronomars/cocentrations.F
+     aeronomars/chemtermos.F
+     aeronomars/calchim.F
+
+--> NB: still there are differences in outputs when order of tracers is changed
+
+== 09/04/09 ==
+>>> fixed problem in 'vdifc.F' which lead to different results when moving
+    tracers around.
+
+== 10/04/09 ==
+>>> corrected small bug in diagnostic outputs of 'watercloud.F' (tendencies were
+    not added to tracer values).
+
+== 21/04/09 ==
+>>> corrected small bug in "physdem1.F" about writing water ice surface tracer
+    to file
+
+== 07/05/09 ==
+>>> very minor correction (firstcall not set to true after first call
+    if no tracers) in convadj.F
+
+== 30/06/09 ==
+>>> Implement reading *def files with IOIPSL ersatz 'getin' function
+   - import "ioipsl_errioipsl.F90","ioipsl_getincom.F90","ioipsl_stringop.F90"
+     in bibio
+   - adapted 'dyn3d/defrun_new.F' to use "getin" function
+   - adapted 'phymars/inifis.F' to use "getin" function
+
+== 01/07/09 ==
+>>> Adapted 'create_make_gcm' so that the "use" in *.F files is identified and
+    corresponding dependencies included in the makefile rules.
+
+>>> Added the 3D scattering from aerosols by JB Madeleine:
+    - minor changes in aerave.F
+    - added the calls to aeropacity.F, and aeroptproperties.F in callradite.F
+    - changed the calls to lwu.F and swr.F in lwmain.F and swmain.F, respectively
+    - added 3D scattering properties in lwu.F and swr.F
+    - added the new aeroptproperties.F, aeropacity.F and suaer.F90 routines
+        (removed dustopacity.F)
+    - updated aeropacity.F with new tracer names
+    - changed the call to callradite.F in physiq.F, added the initialization 
+        of reffrad and nueffrad (aerosol effective radius and variance)
+    - removed all the lines relative to the old "activice" option, including
+        temperature variation due to latent heat release (now in comments)
+    - renamed nsize into naersize in watercloud.F, watersat.F and newsedim.F,
+        to avoid conflicts with another "nsize" variable in the radiative transfer
+    - added the statement of nuice in watercloud.F, which is the effective variance
+        of the log-normal distribution for ice
+    - updated yomaer.h and removed aerice.h (and corresponding "includes")
+
+== 02/07/09 ==
+>>> Adapted 'aeronomars/inichim_readcallphys.F' (called by newstart)
+     to use "getin" routine.
+    + minor correction in 'inifis.F' (close 'iradia.def' file)
+>>> Minor correction in 'dyn3d/dynetat0.F' and 'phymars/phyetat0.F'; do not
+    attempt to reindex tracers if none were found.
+
+>>> in 'deftank' added examples of 'traceur.def' files (traceur.def.co2 : 1
+    co2 tracer; traceur.def.watercycle : 2 traceurs, water vapour and water ice
+    tracer.def.chemistry : all 15 species)
+
+== 06/07/09 ==
+>>> Modified 'makegcm' and makegcm_g95' so that modules files are put 
+    with libraries (and not in current directory)
+    
+== 21/07/09 ==
+>>> Added in "testphys1d.F" a check that the (required) 'run.def' file is
+    around (that file should contain the "INCLUDEDEF=callphys.def" instruction
+    otherwise getin() calls won't work.
+    Also added reding of 'traceur.def' (or initialisation of tracer names
+    to dummy values q01,q02, ...) in testphys1d.F
+
+== 22-24/07/09 == JBM
+>>> Removed "iceparty" everywhere (calchim.F, inichim_readcallphys.F,
+	chimie_data.h, inichim_newstart.F, photochemist_B.F, callkeys.h,
+	callradite.F, callsedim.F, aeropacity.F, inifis.F, initracer.F, physdem1.F,
+	physiq.F, watercloud.F). Water = .true. now implies the use of two
+	tracers, i.e. water vapor and water ice.
+
+>>> Removed fisice.h and stated the corresponding variables in the right
+	places (physiq.F, callsedim.F, watercloud.F, newcondens.F, calchim.F);
+	also removed unused cltop and clsurf variables in physiq.F.
+
+>>> Removed the variable's splitting, which is now obsolete, in callradite.F
+	(and its subroutines lwi.F, lwxb.F, lwxn.F, lwflux.F, lwmain.F, lwxd.F).
+	Also removed the variable's splitting in calldrag_noro.F. Finally removed
+	ndomain from dimradmars.h.
+
+>>> Removed useless tests in aeropacity.F.
+
+== 27-30/07/09 == JBM
+>>> Cleaned the WRITEDIAGFI section in physiq.F, and moved the "mtot",
+	"icetot" and "tauTES" variables from watercloud.F to physiq.F. Also
+	cleaned the albedo change due to water ice deposition.
+
+>>> Renamed rdust into rnuclei in callsedim.F, physiq.F and watercloud.F.
+
+>>> Added a logical test for (water.and..not.tracer) in inifis.F.
+
+>>> Removed "qsurf","zls" and "icount" from the list of inputs in
+	watercloud.F (these variables were not used by the subroutine).
+
+>>> Added a call to watercloud.F at firstcall, using typical dust optical
+	depth (taufirstcall), in order to correctly initialize the ice particle
+	size distribution for the radiative transfer scheme. Also created a new
+	subroutine to load the effective radius and variance of the aerosols used
+	by the radiative transfer scheme. Its name is updatereffrad.F, and it is
+	called before aeroptproperties.F in callradite.F.
+
+== 05/08/09 == JBM
+>>> TES water-ice opacity is now fully computed using the radiatively active
+	aerosol scheme. Absorption coefficient is calculated using Qext and
+	omega at the IR reference wavelength. Omega was not computed before; it
+	was only computed in the GCM channels, not at the reference wavelength.
+	Thus it has been added in suaer.F90, aerave.F, yomaer.h, callradite.F,
+	aeropacity.F and aeroptproperties.F. If "activice" is false, the
+	TES opacity is computed using the old method (fit of the Qabs as a
+	function of reff curve).
+
+== 07/08/09 == EM
+>>> Removed "iceparty" option from callphys.def
+
+>>> modified physiq.F and initracer.F so that building of array niqchem() which
+    contains the indexes of all chemistry tracers + water vapour and water
+    ice is done in initracer.F (array niqchem(:) is now a common
+    in tracer.h ).
+    Also had to adapt inichim_newstart.F to behave similarly.
+
+== 24/08/09 == EM included corrections by JBM
+>>> Added declaration of nqchem(nqmx) local array in
+    aeronomars/inichim_newstart.F
+
+>>> Encapsulated calls to writediagfi & wstats in if (ngrid.ne.1) clause
+    in phymars/aeropacity.F (otherwise it crashes in 1D).
+
+== 26/08/09 == EM
+>>> modified tracer.h, initracer.F, inichim_newstart.F and physiq.F to not use
+    an niqchem() array (ie: removed 07/08/09 changes).
+
+>>> modified phymars/readtesassim.F90 and phymars/aeropacity.F so that
+    assimilated dust for MY24 or MY25 or MY26 may be used (with iaervar=
+    24,25 or 26); we keep iaervar=4 to also read MY24 dust for compatibility
+    with older versions of code.
+    Modified deftank/callphys.def : added comments about new iaervar values
+
+== 25/09/09 == EM
+>>> modified phymars/testphys1D.F : added incrementation of tracer values
+    after call to physiq().
+
+== 27/11/09 == EM
+>>> updated comments in makegcm (translated help to english)
+
+>> shifted to reading file traceur.def
+   (dyn3d/iniadvtrac.F) in an Earth-LMDZ4 like way:
+   first line == number of tracers
+   and then tracer name (1 per line; later we'll add advection scheme type)
+>> also updated example 'traceur.def' files in deftank accordingly
+
+== 04/12/09 == EM
+>>> upgraded testphys1d.F and profile.F to load run parameters with getin()
+    function (from run.def ; no need for a "testphys1d.def" any more)
+    added an example 'run.def.1d' file to 'deftank'
+==10/12/09 == EM
+>>> minor correction in testphys1d.F (was still checking if there is a
+    testphys1d.def file around ; which is not used anymore)
+
+==15/01/10 == JBM
+>>> aeropacity.F: implemented a weighting of the dust opacity profile
+  by using the dust size vertical profile defined in updatereffrad.F.
+>>> aeroptproperties.F: changed the integration scheme (Gauss-Legendre)
+  of the scattering parameters.
+>>> suaer.F90: removed the use of an ad-hoc "solsir" factor. It is now
+  directly computed from the scattering properties read in the ASCII
+  files. Consequently, the IR extinction coefficient has been divided
+  by solsir=2 in the ASCII file (called optprop_dustir_x0.5.dat instead
+  of optprop_dustir.dat to allow compatibility with the older version
+  and avoid chaos).
+>>> updatereffrad.F: changed the dust size vertical profile.
+>>> yomaer.h: the particle radius variable is now in simple precision,
+  because the new scattering property integration scheme has changed.
+>>> aeronomars/inichim_readcallphys.F (small) bug correction load value of
+    'water' before testing its value...
+
+== 18/01/10 == EM
+>> added possibility to read (in inifis.F and aeropacity.F) the value of
+   dust opacity tauvis from callphys.def file
+
+===> 18/01/10 : "delivery" of current version for the Mesoscale Model.
+
+== 01/02/10 == EM
+>> add JBM updates of "callradite.F" (coments) "aeroptproperties.F" (bug fix
+   of bad array bounds) and "aeropacity.F" (encapsulate wstats calls in
+   if (callstats) )
+
+== 03/02/10 == EM
+>> added implementation of TES Cap albedos: "albedocaps.F90" and adapted
+   "newcondens.F"  (and physiq.F, because added 'zls' argument to newcondens)
+   and surfdat.h
+>> changed default settings for dust : set a 1.3 factor in readtesassim.F90
+   when using Toon radiative transfer, use M.Wolff-T-Matrix files in suaer.F90
+>> Updated newstart.F in dyn3d, so that sub-surface thermal inertia values may
+   be different in North and South hemispheres.
+>> Updated "makegcm" and "makegcm_g95" scripts (cosmetic + default compilation
+   option changes)
+>> Minor changes in aeronomars/init_chimie_B.F (do not use lnblnk(); F90
+   trim() intrinsic is much safer and better), and in initracer.F (better
+   control over a possible array bound underflow).
+   Also, in dyn3d/iniadvtrac.F, close input file properly,
+   and in infis.F, more verbose message to output.
+
+NB mesoscale : options de compilations a voir 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.err
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.err	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.err	(revision 46)
@@ -0,0 +1,1121 @@
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/calchim.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/chemthermos.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/ch.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/column.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/concentrations.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/conduction.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/dtridgl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/euvheat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/flujo.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/getch.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/hrtherm.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/inichim_newstart.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/inichim_readcallphys.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/init_chimie_B.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/intrplf.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/inv.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/jthermcalc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/moldiffcoeff.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/moldiff.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/molvis.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/paramfoto.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/param_read.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/perosat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/phdisrate.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/photochemist_B.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/thermosphere.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/calchim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/ch.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/chemthermos.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/column.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/concentrations.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/conduction.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/dtridgl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/euvheat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/flujo.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/getch.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/hrtherm.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/inichim_newstart.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/inichim_readcallphys.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/init_chimie_B.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/intrplf.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/inv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/jthermcalc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/moldiff.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/moldiffcoeff.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/molvis.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/param_read.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/paramfoto.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/perosat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/phdisrate.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/photochemist_B.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/nocompile/.svn/text-base/thermosphere.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/.svn/text-base/chimiedata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/.svn/text-base/conc.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/.svn/text-base/interpfast.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/.svn/text-base/param.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/aeronomars/.svn/text-base/param_v3.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/cbrt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/cvmgp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/cvmgt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/from36.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/gather.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ilsum.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ini36.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ioipsl_errioipsl.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ioipsl_getincom.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ioipsl_stringop.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/isamax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/isitor.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ismax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ismin.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/lmdstd.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/lnblnk.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/mxm.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/mxv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/mxva.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/mywrite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/readcoord.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/readstd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/scatter.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/scopy.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/scopyi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/sdot.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/ssum.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/to36.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/wheneq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/bibio/.svn/text-base/writestd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/diff.log.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/control.h~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/advtrac.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/angtot.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/clesph0.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comav.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comconst.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comdiss.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comdissip.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comdissipn.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comdissnew.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comgeom.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comgeom2.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/comvert.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/control.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/description.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/diff.log.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/ener.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/gradsdef.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/logic.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/para_netcdf.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/paramet.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/serre.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/sponge.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/temps.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/.svn/text-base/tracstoke.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/grid/.svn/text-base/fxy_new.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/grid/.svn/text-base/fxy_reg.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/grid/.svn/text-base/fxy_sin.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/grid/.svn/text-base/fxyprim.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerdata.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerdust.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerdust.h.clan91: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerdust.h.ocke97: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.005: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.01: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.02: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.03: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.04: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.05: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aerice.h.10: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/callsedim2q.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_physiq.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_physiq.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_inifis.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/calldrag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/callradite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/dimradmars.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwflux.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwxb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwxd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/lwxn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/swmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/callradite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/dimradmars.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwxb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwxd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/lwxn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/splitting/.svn/text-base/swmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerave.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdata.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.clan91: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.ocke97: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.005: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.01: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.02: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.03: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.04: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.05: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.10: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blackl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blendrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callkeys.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim2q.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/co2snow.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comcstfi.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgp.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comdiurn.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comg1d.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comgeomfi.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comorbit.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsaison.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/convadj.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgt.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datafile.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datareadnc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/def_var.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimphys.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/drag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustdevil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustlift.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/suaer.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/flusv.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/growthrate.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwprofil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwstress.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ineofdump.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeropacity.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inifis.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniorbit.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inistats.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/initracer.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwrite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismax.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismin.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwdiff.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwtt.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwu.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mkstat.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mucorr.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mufract.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/multipl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newcondens.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newsedim.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nirco2abs.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltecool.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltedata.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlteparams.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlthermeq.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orbite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orodrag.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orosetup.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/phyetat0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physdem1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeroptproperties.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/planete.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/profile.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/readtesassim.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scatter.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scopyi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solang.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solarlong.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/statto.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sugwd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sulw.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfdat.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfini.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tabfi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/testphys1d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tracer.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/updatereffrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_cd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdifc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_kc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vlz_fi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercap.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercloud.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsoil.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watersat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagfi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writeg1d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/wstats.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yoegwd.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomaer.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomlw.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/zerophys.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwritesoil.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagsoil.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/interp_line.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil_settings.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_toon.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_fouquart.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swrayleigh.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physiq.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/albedocaps.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerave.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerdata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerdust.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerdust.h.clan91.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerdust.h.ocke97.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.005.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.01.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.02.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.03.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.04.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.05.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aerice.h.10.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aeropacity.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/aeroptproperties.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/albedocaps.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/blackl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/blendrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/callkeys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/callradite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/callsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/callsedim2q.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/co2snow.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comcstfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comdiurn.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comg1d.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comgeomfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comorbit.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comsaison.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/comsoil.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/convadj.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/cvmgp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/cvmgt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/datafile.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/datareadnc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/def_var.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/dimphys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/dimradmars.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/drag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/dustdevil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/dustlift.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/eofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/eofdump.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/flusv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/growthrate.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/gwprofil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/gwstress.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/ineofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/inifis.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/iniorbit.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/inistats.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/initracer.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/iniwrite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/iniwritesoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/interp_line.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/ismax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/ismin.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwdiff.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwtt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwu.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwxb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwxd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/lwxn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/mkstat.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/mucorr.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/mufract.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/multipl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/newcondens.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/newsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/nirco2abs.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/nltecool.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/nltedata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/nlteparams.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/nlthermeq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/orbite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/orodrag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/orosetup.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/phyetat0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/physdem1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/physiq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/planete.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/profile.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/readtesassim.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/scatter.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/scopyi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/soil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/soil_settings.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/solang.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/solarlong.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/statto.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/suaer.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/sugwd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/sulw.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/surfdat.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/surfini.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/swmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/swr_fouquart.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/swr_toon.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/swrayleigh.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/tabfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/testphys1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/tracer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/updatereffrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/vdif_cd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/vdif_kc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/vdifc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/vlz_fi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/watercap.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/watercloud.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/watersat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/writediagfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/writediagsoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/writeg1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/wstats.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/yoegwd.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/yomlw.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/text-base/zerophys.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/.svn/prop-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_testphys1d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/assim_aeropacity.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/assim_readtesassim.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_dimphys.h_ref: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/param_slope.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/diff.log.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/slope.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/param_slope_full.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/meso_inifis.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/gr_fi_dyn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/newcondens.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/surfdat.h~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aeropacity.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/callradite.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/calldrag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/sugwd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/drag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/gwprofil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/gwstress.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/orodrag.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/orosetup.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/physdem1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/drag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/gwprofil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/gwstress.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/orodrag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/orosetup.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/physdem1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/text-base/sugwd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/gwprofil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/gwstress.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/orodrag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/orosetup.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/physdem1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/nocompile/.svn/prop-base/sugwd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerave.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerdata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerdust.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerdust.h.clan91.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerdust.h.ocke97.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.005.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.01.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.02.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.03.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.04.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.05.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aerice.h.10.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aeropacity.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/aeroptproperties.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/albedocaps.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/assim_aeropacity.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/assim_readtesassim.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/blackl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/blendrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/callkeys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/callradite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/callsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/callsedim2q.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/co2snow.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comcstfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comdiurn.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comg1d.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comgeomfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comorbit.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comsaison.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/comsoil.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/convadj.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/cvmgp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/cvmgt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/datafile.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/datareadnc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/def_var.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/diff.log.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/dimphys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/dimradmars.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/dustdevil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/dustlift.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/eofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/eofdump.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/flusv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/gr_fi_dyn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/growthrate.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/ineofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/iniorbit.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/inistats.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/initracer.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/iniwrite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/iniwritesoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/interp_line.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/ismax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/ismin.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwdiff.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwtt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwu.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwxb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwxd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/lwxn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/meso_dimphys.h_ref.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/meso_inifis.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/meso_physiq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/meso_testphys1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/mkstat.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/mucorr.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/mufract.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/multipl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/newcondens.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/newsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/nirco2abs.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/nltecool.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/nltedata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/nlteparams.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/nlthermeq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/orbite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/param_slope.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/param_slope_full.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/phyetat0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/planete.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/profile.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/readtesassim.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/scatter.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/scopyi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/slope.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/soil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/soil_settings.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/sulw.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/solang.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/solarlong.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/statto.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/suaer.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/surfdat.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/surfini.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/swmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/swr_fouquart.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/swr_toon.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/swrayleigh.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/tabfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/tracer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/updatereffrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/vdif_cd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/vdif_kc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/vdifc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/vlz_fi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/watercap.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/watercloud.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/watersat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/writediagfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/writediagsoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/writeg1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/wstats.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/yoegwd.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/yomlw.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/text-base/zerophys.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/callkeys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/callradite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/datafile.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/dimradmars.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwxb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwxd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/lwxn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/meso_dimphys.h_ref.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/swmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars/.svn/prop-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerave.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerdata.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerdust.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerdust.h.clan91: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerdust.h.ocke97: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.005: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.01: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.02: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.03: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.04: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.05: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aerice.h.10: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/blackl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/blendrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/callsedim2q.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/callsedim.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/co2snow.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comcstfi.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/cvmgp.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comdiurn.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/datafile.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comg1d.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comgeomfi.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comorbit.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comsaison.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/convadj.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/cvmgt.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/datareadnc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/def_var.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/dimphys.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/dimradmars.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/dustdevil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/dustlift.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/suaer.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/eofdump.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/eofdump.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/flusv.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/growthrate.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_physiq.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_physiq.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/ineofdump.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aeropacity.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/iniorbit.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_inifis.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/inistats.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/initracer.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/iniwrite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/ismax.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/ismin.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwdiff.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwtt.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwu.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwflux.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/mkstat.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/mucorr.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/mufract.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/multipl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/newsedim.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nirco2abs.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nltecool.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nltedata.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nlteparams.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nlthermeq.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/orbite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/phyetat0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aeroptproperties.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/planete.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/profile.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/soil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/readtesassim.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/scatter.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/scopyi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/solang.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/solarlong.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/statto.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/sulw.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/surfdat.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/surfini.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/swmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/tabfi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/tracer.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/updatereffrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/vdif_cd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/vdifc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/vdif_kc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/vlz_fi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/watercap.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/watercloud.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_testphys1d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/comsoil.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/watersat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/writediagfi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/writeg1d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/yomlw.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/wstats.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/yoegwd.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/yomaer.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/zerophys.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/iniwritesoil.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/writediagsoil.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/interp_line.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/soil_settings.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/swr_toon.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/swr_fouquart.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/swrayleigh.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwmain.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwxb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwxd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/lwxn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/callradite.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/assim_aeropacity.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/assim_readtesassim.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_dimphys.h_ref: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/param_slope.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/diff.log.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/callkeys.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/slope.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/newcondens.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/param_slope_full.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/meso_inifis.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/gr_fi_dyn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/newcondens.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/albedocaps.F90: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/surfdat.h~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/aeropacity.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/callradite.F~: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/calldrag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/sugwd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/drag_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/gwprofil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/gwstress.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/orodrag.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/orosetup.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/physdem1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/drag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/gwprofil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/gwstress.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/orodrag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/orosetup.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/physdem1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/text-base/sugwd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/calldrag_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/gwprofil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/gwstress.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/orodrag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/orosetup.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/physdem1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/nocompile/.svn/prop-base/sugwd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerave.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerdata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerdust.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerdust.h.clan91.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerdust.h.ocke97.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.005.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.01.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.02.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.03.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.04.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.05.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aerice.h.10.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aeropacity.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/aeroptproperties.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/albedocaps.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/assim_aeropacity.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/assim_readtesassim.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/blackl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/blendrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/callkeys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/callradite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/callsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/callsedim2q.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/co2snow.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comcstfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comdiurn.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comg1d.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comgeomfi.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comorbit.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comsaison.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/comsoil.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/convadj.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/cvmgp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/cvmgt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/datafile.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/datareadnc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/def_var.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/diff.log.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/dimphys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/dimradmars.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/dustdevil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/dustlift.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/eofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/eofdump.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/flusv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/gr_fi_dyn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/growthrate.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/ineofdump.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/iniorbit.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/inistats.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/initracer.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/iniwrite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/iniwritesoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/interp_line.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/ismax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/ismin.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwdiff.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwtt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwu.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwxb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwxd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/lwxn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/meso_dimphys.h_ref.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/meso_inifis.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/meso_physiq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/meso_testphys1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/mkstat.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/mucorr.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/mufract.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/multipl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/newcondens.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/newsedim.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/nirco2abs.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/nltecool.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/nltedata.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/nlteparams.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/nlthermeq.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/orbite.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/param_slope.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/param_slope_full.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/phyetat0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/planete.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/profile.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/readtesassim.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/scatter.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/scopyi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/slope.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/soil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/soil_settings.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/sulw.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/solang.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/solarlong.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/statto.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/suaer.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/surfdat.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/surfini.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/swmain.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/swr_fouquart.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/swr_toon.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/swrayleigh.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/tabfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/tracer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/updatereffrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/vdif_cd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/vdif_kc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/vdifc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/vlz_fi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/watercap.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/watercloud.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/watersat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/writediagfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/writediagsoil.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/writeg1d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/wstats.F90.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/yoegwd.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/yomlw.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/text-base/zerophys.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/prop-base/callkeys.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/prop-base/datafile.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/prop-base/meso_dimphys.h_ref.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/phymars_nods/.svn/prop-base/yomaer.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/abort_gcm.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/addfi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/addit.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/advect.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/adv_h2o.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/amont.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/amont_qsat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/anldoppler2.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/anl_mcdstats.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/anl_stats-diag.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/bernoui.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/caldyn0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/caldyn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/calfis.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/coefpoly.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/convflu.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/convmas.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/coordij.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/covcont.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/covnat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/defrun_new.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/diagadv.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dissip.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dudv1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/disvert.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/diverg.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/divergf.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/diverg_gam.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/divergst.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/divgrad22.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/divgrad2.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/divgrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dteta1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dudv2.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dump2d.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dynetat0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/dynredem.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/enercin.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/exner.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/exner_hyb.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/flumass.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fluxstoke.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fxhyp.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fxy.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fxyhyper.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fxysinus.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/fyhyp.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gcm.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/geopot.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/grad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/iniav.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gradiv2.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gradiv.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gr_dyn_fi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gr_fi_dyn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/grid_atob.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/grid_noro1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/grid_noro.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gr_int_dyn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/groupe.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/groupeun.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gr_u_scal.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/gr_v_scal.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/heavyside.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/iniadvtrac.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/ini_archive.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/iniconst.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/inidissip.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/inigeom.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/inigrads.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/iniinterp_h.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/initial0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/integrd.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/interp_horiz.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/interp_vert.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/laplacien.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/laplacien_gam.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/laplacien_rot.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/laplacien_rotgam.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/lectflux.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/lect_start_archive.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/massbar.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/massbarxy.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/massdair.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/minmax.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/multipl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/multscal.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/newstart.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/nxgrad.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/nxgrad_gam.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/nxgradst.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/nxgraro2.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/nxgrarot.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/pression.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/psextbar.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/ran1.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/readhead_NC.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/rotat.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/rotatf.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/rotat_nfil.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/rotatst.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/scal_wind.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/sortvarc0.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/sortvarc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/spline.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/splint.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/sponge.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/start2archive.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/testharm.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/test_period.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/tourpot.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/traceur.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/tracvl.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/vanleer.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/vitvert.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/vlsplt.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/vlspltqs.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/wind_scal.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/wrgrads.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/write_archive.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/xvik.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/abort_gcm.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/addfi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/addit.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/adv_h2o.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/advect.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/amont.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/amont_qsat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/anl_mcdstats.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/anl_stats-diag.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/anldoppler2.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/bernoui.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/caldyn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/caldyn0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/calfis.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/coefpoly.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/convflu.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/convmas.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/coordij.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/covcont.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/covnat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/defrun_new.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/diagadv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dissip.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/disvert.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/diverg.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/diverg_gam.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/divergf.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/divergst.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/divgrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/divgrad2.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/divgrad22.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dteta1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dudv1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fxy.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dudv2.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dump2d.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dynetat0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/dynredem.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/enercin.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/exner.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/exner_hyb.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/flumass.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fluxstoke.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fxhyp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fxyhyper.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fxysinus.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/fyhyp.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gcm.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/geopot.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gr_dyn_fi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gr_fi_dyn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/grad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gr_int_dyn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gr_u_scal.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gr_v_scal.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gradiv.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/gradiv2.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/grid_atob.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/grid_noro.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/grid_noro1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/groupe.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/groupeun.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/heavyside.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/ini_archive.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/iniadvtrac.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/iniav.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/iniconst.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/inidissip.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/ran1.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/inigeom.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/inigrads.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/iniinterp_h.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/initial0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/integrd.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/interp_horiz.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/interp_vert.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/laplacien.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/laplacien_gam.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/laplacien_rot.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/laplacien_rotgam.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/lect_start_archive.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/lectflux.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/massbar.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/massbarxy.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/massdair.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/minmax.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/multipl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/multscal.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/newstart.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/nxgrad.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/nxgrad_gam.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/nxgradst.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/nxgraro2.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/nxgrarot.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/pression.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/psextbar.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/readhead_NC.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/rotat.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/rotat_nfil.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/rotatf.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/rotatst.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/scal_wind.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/sortvarc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/sortvarc0.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/spline.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/splint.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/sponge.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/start2archive.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/test_period.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/testharm.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/tourpot.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/traceur.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/tracvl.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/vanleer.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/vitvert.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/vlsplt.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/vlspltqs.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/wind_scal.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/wrgrads.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/write_archive.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/dyn3d/.svn/text-base/xvik.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/coefils.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/acc.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/eigen_sort.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/eigen.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/filtreg.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/inifgn.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/inifilr.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/jacobi.F: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/parafilt.h: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/acc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/coefils.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/eigen.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/eigen_sort.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/filtreg.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/inifgn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/inifilr.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/jacobi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/text-base/parafilt.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/acc.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/coefils.h.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/eigen.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/eigen_sort.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/filtreg.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/inifgn.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/inifilr.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/jacobi.F.svn-base: No such file or directory
+diff: /u/emlmd/LMDZ.MARS.BETA//libf/zz_not_used/filtrez/.svn/prop-base/parafilt.h.svn-base: No such file or directory
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.log
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.log	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/comp_sources.log	(revision 46)
@@ -0,0 +1,6405 @@
+*** libf/dyn3d/comconst.h	Tue Jan 25 16:49:08 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/comconst.h	Fri Sep  3 08:53:10 2010
+***************
+*** 1,9 ****
+  !-----------------------------------------------------------------------
+  ! INCLUDE comconst.h
+  
+!       COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,
+!      * dtvr,daysec,
+!      * pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
+  
+        INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+        REAL dtvr,daysec
+--- 1,9 ----
+  !-----------------------------------------------------------------------
+  ! INCLUDE comconst.h
+  
+!       COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,           &
+!      & dtvr,daysec,                                                     &
+!      & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
+  
+        INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+        REAL dtvr,daysec
+*** libf/dyn3d/comvert.h	Tue Jan 25 16:49:08 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/comvert.h	Fri Sep  3 08:53:18 2010
+***************
+*** 1,12 ****
+! c-----------------------------------------------------------------------
+! c   INCLUDE 'comvert.h'
+  
+!       COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
+!      .               pa,preff,nivsigs(llm),nivsig(llm+1),
+!      .               sig(llm+1),ds(llm),aps(llm),bps(llm),pseudoalt(llm)
+  
+        REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+! c Mars Ce qui suit vient de gcm
+        REAL sig,ds,aps,bps,pseudoalt
+  
+! c-----------------------------------------------------------------------
+--- 1,12 ----
+! !-----------------------------------------------------------------------
+! !   INCLUDE 'comvert.h'
+  
+!       COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,     &
+!      &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
+!      &               sig(llm+1),ds(llm),aps(llm),bps(llm),pseudoalt(llm)
+  
+        REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+! ! Mars Ce qui suit vient de gcm
+        REAL sig,ds,aps,bps,pseudoalt
+  
+! !-----------------------------------------------------------------------
+*** libf/dyn3d/control.h	Tue Jan 25 16:49:08 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/dyn3d/control.h	Wed Sep 17 11:58:26 2008
+***************
+*** 2,8 ****
+  ! INCLUDE 'control.h'
+  ! For Fortran 77/Fortran 90 compliance always use line continuation
+  ! symbols '&' in columns 73 and 6
+! ! newWRF: OK
+  
+        COMMON/control/nday,day_step,                                     &
+       &              iperiod,iconser,idissip,iphysiq ,                   &
+--- 2,8 ----
+  ! INCLUDE 'control.h'
+  ! For Fortran 77/Fortran 90 compliance always use line continuation
+  ! symbols '&' in columns 73 and 6
+! !
+  
+        COMMON/control/nday,day_step,                                     &
+       &              iperiod,iconser,idissip,iphysiq ,                   &
+*** libf/phymars/callsedim.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/callsedim.F	Thu Dec  2 18:42:35 2010
+***************
+*** 1,5 ****
+        SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+!      $                pplev,zlev, pt, rnuclei, rice,
+       &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+        IMPLICIT NONE
+  
+--- 1,5 ----
+        SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+!      $                pplev,zlev, pt, rdust, rice,
+       &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+        IMPLICIT NONE
+  
+***************
+*** 9,14 ****
+--- 9,18 ----
+  c
+  c      F.Forget 1999
+  c
++ c      Modified by J.-B. Madeleine 2010: Now includes the doubleq
++ c        technique in order to have only one call to callsedim in
++ c        physiq.F.
++ c
+  c=======================================================================
+  
+  c-----------------------------------------------------------------------
+***************
+*** 32,39 ****
+        REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+        REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+  c    Aerosol radius provided by the water ice microphysical scheme:
+!       REAL rnuclei(ngrid,nlay)   ! Prescribed dust radius in each layer (m)
+!       REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+  
+  c    Traceurs :
+        integer nq             ! number of tracers
+--- 36,43 ----
+        REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+        REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+  c    Aerosol radius provided by the water ice microphysical scheme:
+!       REAL rdust(ngrid,nlay)     ! Dust geometric mean radius (m)
+!       REAL rice(ngrid,nlay)      ! Ice geometric mean radius (m)
+  
+  c    Traceurs :
+        integer nq             ! number of tracers
+***************
+*** 45,59 ****
+  c   local:
+  c   ------
+  
+        INTEGER l,ig, iq
+  
+!       real zqi(ngridmx,nlayermx) ! to locally store tracers
+        real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
+        real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
+        real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
+! c      real dens(ngridmx,nlayermx) ! Mean density of the ice part. accounting for dust core
+        real rfall(ngridmx,nlayermx)
+  
+  
+        LOGICAL firstcall
+        SAVE firstcall
+--- 49,104 ----
+  c   local:
+  c   ------
+  
++       REAL CBRT
++       EXTERNAL CBRT
++ 
+        INTEGER l,ig, iq
+  
+!       real zqi(ngridmx,nlayermx,nqmx) ! to locally store tracers
+        real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
+        real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
+        real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
+!       real r0(ngridmx,nlayermx) ! geometric mean doubleq radius (m)
+! c     Sedimentation radius of water ice
+        real rfall(ngridmx,nlayermx)
++ c     Sedimentation effective variance of water ice
++       REAL, PARAMETER :: nuice_sed = 0.1
++ 
++ c     Discrete size distributions (doubleq)
++ c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
++ c       1) Parameters used to represent the changes in fall
++ c          velocity as a function of particle size;
++       integer nr,ir
++       parameter (nr=12) !(nr=7) ! number of bins
++       real rd(nr),qr(ngridmx,nlayermx,nr)
++       real rdi(nr+1)    ! extreme and intermediate radii
++       real Sq(ngridmx,nlayermx)
++       real rdmin,rdmax,rdimin,rdimax
++       data rdmin/1.e-8/ !/1.e-7/
++       data rdmax/30.e-6/
++       data rdimin/1.e-10/
++       data rdimax/1e-4/
++       save rd, rdi
++ 
++ c       2) Second size distribution for the log-normal integration
++ c          (the mass mixing ratio is computed for each radius)
++ 
++       integer ninter, iint
++       parameter (ninter=4)  ! nombre de point entre chaque rayon rdi
++       real rr(ninter,nr)
++       save rr
++       integer radpower
++ 
++ c       3) Other local variables used in doubleq
++ 
++       real reff(ngridmx,nlayermx,2)  ! for diagnostic only
++       INTEGER idust_mass   ! index of tracer containing dust mass
++                            !   mix. ratio
++       INTEGER idust_number ! index of tracer containing dust number
++                            !   mix. ratio
++       SAVE idust_mass,idust_number
+  
++ c     Firstcall:
+  
+        LOGICAL firstcall
+        SAVE firstcall
+***************
+*** 71,87 ****
+              STOP
+           ENDIF
+        
+          firstcall=.false.
+        ENDIF ! of IF (firstcall)
+  
+  c-----------------------------------------------------------------------
+! c    1. initialisation
+  c    -----------------
+- c
+- c     Calcul preliminaires  de caracteristiques des couches
+- c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+- c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+  
+  
+        do  l=1,nlay
+          do ig=1, ngrid
+--- 116,194 ----
+              STOP
+           ENDIF
+  
++ c       Doubleq: initialization
++         IF (doubleq) THEN
++          do ir=1,nr
++              rd(ir)= rdmin*(rdmax/rdmin)**(float(ir-1)/float(nr-1))
++          end do
++          rdi(1)=rdimin
++          do ir=2,nr
++            rdi(ir)= sqrt(rd(ir-1)*rd(ir))
++          end do
++          rdi(nr+1)=rdimax
++ 
++          do ir=1,nr
++            do iint=1,ninter
++              rr(iint,ir)=
++      &        rdi(ir)*
++      &        (rdi(ir+1)/rdi(ir))**(float(iint-1)/float(ninter-1))
++ c             write(*,*) rr(iint,ir)
++            end do
++          end do
++ 
++       ! identify tracers corresponding to mass mixing ratio and
++       ! number mixing ratio
++         idust_mass=0      ! dummy initialization
++         idust_number=0    ! dummy initialization
++ 
++         do iq=1,nq
++           if (noms(iq).eq."dust_mass") then
++             idust_mass=iq
++           endif
++           if (noms(iq).eq."dust_number") then
++             idust_number=iq
++           endif
++         enddo
++ 
++         ! check that we did find the tracers
++         if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
++           write(*,*) 'callsedim: error! could not identify'
++           write(*,*) ' tracers for dust mass and number mixing'
++           write(*,*) ' ratio and doubleq is activated!'
++           stop
++         endif
++         ENDIF !of if (doubleq)
++ 
++         IF (water) THEN
++           write(*,*) "water_param nueff Sedimentation:", nuice_sed
++           IF (activice) THEN
++             write(*,*) "water_param nueff Radiative:", nuice_ref
++           ENDIF
++         ENDIF
++       
+          firstcall=.false.
+        ENDIF ! of IF (firstcall)
+  
+  c-----------------------------------------------------------------------
+! c    1. Initialization
+  c    -----------------
+  
++       zqi(1:ngrid,1:nlay,1:nqmx) = 0.
++ c     Updating the mass mixing ratio with the tendencies coming
++ c       from other parameterizations:
++ c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
++ 
++       do iq=1,nq
++         do l=1,nlay
++           do ig=1,ngrid
++             zqi(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
++           enddo
++         enddo 
++       enddo
++ 
++ c    Computing the different layer properties
++ c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
++ c    Mass (kg.m-2), thickness(m), crossing time (s)  etc.
+  
+        do  l=1,nlay
+          do ig=1, ngrid
+***************
+*** 90,156 ****
+          end do
+        end do
+  
+        do iq=1,nq
+!         if(radius(iq).gt.1.e-9) then   ! no sedim for gaz (defined by radius=0)
+  
+! c         On "update" la valeur de q apres les autres parametrisations
+! c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  
+            do l=1,nlay
+              do ig=1,ngrid
+!               ! store locally updated tracers
+!               zqi(ig,l)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+! !              if (iceparty.and.iq.eq.nq-1) then
+!               if (water.and.(iq.eq.igcm_h2o_ice)) then
+! c               On affecte un rayon moyen aux poussieres a chaque altitude du type :
+! c               r(z)=r0*exp(-z/H) avec r0=0.8 micron et H=18 km.
+! c               ''''''''''''''''''''''''''''''''''''''''''''''''
+!                 rfall(ig,l)=max( rice(ig,l)*1.5,rnuclei(ig,l) )
+  c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
+                  rfall(ig,l)=min(rfall(ig,l),1.e-4)
+- !mars commente pour l'instant               rfall(ig,l)=20.e-6
+-               endif
+              enddo
+            enddo ! of do l=1,nlay
+! 
+! c         Calcul du transport par sedimentation pour chaque traceur
+! c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! !          if(iceparty.and.iq.eq.nq-1) then
+!           if (water.and.(iq.eq.igcm_h2o_ice)) then
+              call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+!      &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi,wq)
+            else
+              call newsedim(ngrid,nlay,1,ptimestep,
+!      &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),zqi,wq)
+!           endif
+! 
+! c         Calcul des tendances
+! c         ~~~~~~~~~~~~~~~~~~~~
+            do ig=1,ngrid 
+- !            if(iceparty.and.iq.eq.nq-1) then
+- !                pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+- !            else
+- !                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+- !            endif
+- ! Temporary: surface ice is qsurf(igcm_h2o_vap) ! no more
+- !            if(iceparty.and.(iq.eq.igcm_h2o_ice)) then
+- !                pdqs_sed(ig,igcm_h2o_vap) = wq(ig,1)/ptimestep 
+- !            else
+- !                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+- !            endif
+- ! Ehouarn: with new way of tracking tracers by name, it should now simply be
+              pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+            end do
+  
+            DO l = 1, nlay
+              DO ig=1,ngrid
+! c	      zqi(ig,l)=max(zqi(ig,l), 1.e-10)
+!               pdqsed(ig,l,iq)=(zqi(ig,l)-
+       $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+              ENDDO
+            ENDDO
+  
+          endif ! of if(radius(iq).gt.1.e-9)
+        enddo ! of do iq=1,nq
+   
+        RETURN
+--- 197,355 ----
+          end do
+        end do
+  
++ c =================================================================
+        do iq=1,nq
+!         if(radius(iq).gt.1.e-9) then   ! no sedim for gaz
+! 
+! c -----------------------------------------------------------------
+! c         DOUBLEQ CASE
+! c -----------------------------------------------------------------
+!           if (doubleq.and.
+!      &        ((iq.eq.idust_mass).or.
+!      &         (iq.eq.idust_number))) then
+  
+! c           Computing size distribution:
+! c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  
+              do  l=1,nlay
++               do ig=1, ngrid
++                 r0(ig,l)=
++      &            CBRT(r3n_q*zqi(ig,l,idust_mass)/
++      &            max(zqi(ig,l,idust_number),0.01))
++                 r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
++               end do
++             end do
++ 
++ c        Computing mass mixing ratio for each particle size
++ c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
++           IF (iq.EQ.idust_mass) then
++             radpower = 2
++           ELSE
++             radpower = -1
++           ENDIF
++           Sq(1:ngrid,1:nlay) = 0.
++           do ir=1,nr
++             do l=1,nlay
++               do ig=1,ngrid
++ c                ****************
++ c                Size distribution integration
++ c                (Trapezoid Integration Method)
++                  qr(ig,l,ir)=0.5*(rr(2,ir)-rr(1,ir))*
++      &             (rr(1,ir)**radpower)*
++      &             exp(-(log(rr(1,ir)/r0(ig,l)))**2/(2*varian**2))
++                  do iint=2,ninter-1
++                    qr(ig,l,ir)=qr(ig,l,ir) +
++      &             0.5*(rr(iint+1,ir)-rr(iint-1,ir))*
++      &             (rr(iint,ir)**radpower)*
++      &             exp(-(log(rr(iint,ir)/r0(ig,l)))**2/
++      &             (2*varian**2))
++                  end do
++                  qr(ig,l,ir)=qr(ig,l,ir) +
++      &             0.5*(rr(ninter,ir)-rr(ninter-1,ir))*
++      &             (rr(ninter,ir)**radpower)*
++      &             exp(-(log(rr(ninter,ir)/r0(ig,l)))**2/
++      &             (2*varian**2))
++ 
++ c                **************** old method (not recommended!)
++ c                qr(ig,l,ir)=(rd(ir)**(5-3*iq))*
++ c    &           exp( -(log(rd(ir)/r0(ig,l)))**2 / (2*varian**2) )
++ c                ******************************
++ 
++                  Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir)
++               enddo
++             enddo
++           enddo
++ 
++           do ir=1,nr
++             do l=1,nlay
+                do ig=1,ngrid
+!                  qr(ig,l,ir) = zqi(ig,l,iq)*qr(ig,l,ir)/Sq(ig,l)
+!               enddo
+!             enddo
+!           enddo
+! 
+! c         Computing sedimentation for each tracer
+! c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! c         call zerophys(ngridmx*nlayermx,zqi(1,1,iq))
+!           zqi(1:ngrid,1:nlay,iq) = 0.
+! c         call zerophys(ngridmx,pdqs_sed(1,iq))
+!           pdqs_sed(1:ngrid,iq) = 0.
+! 
+!           do ir=1,nr
+!              call newsedim(ngrid,nlay,1,ptimestep,
+!      &       pplev,masse,epaisseur,pt,rd(ir),rho_dust,qr(1,1,ir),
+!      &       wq,0.5)
+! 
+! c            Tendencies
+! c            ~~~~~~~~~~
+!              do ig=1,ngrid
+!                pdqs_sed(ig,iq) = pdqs_sed(ig,iq)
+!      &                                + wq(ig,1)/ptimestep
+!              end do
+!              DO l = 1, nlay
+!                DO ig=1,ngrid
+!                  zqi(ig,l,iq)=zqi(ig,l,iq)+qr(ig,l,ir)
+!                ENDDO
+!              ENDDO
+!           enddo ! of do ir=1,nr
+! c -----------------------------------------------------------------
+! c         WATER CYCLE CASE
+! c -----------------------------------------------------------------
+!           else if (water.and.(iq.eq.igcm_h2o_ice)) then
+! c           if (doubleq) then
+! c             do l=1,nlay
+! c               do ig=1,ngrid
+! c                 rfall(ig,l)=max( rice(ig,l),rdust(ig,l) )
+! c                 rfall(ig,l)=min(rfall(ig,l),1.e-4)
+! c               enddo
+! c             enddo ! of do l=1,nlay
+! c           else
+!               do l=1,nlay
+!                 do ig=1,ngrid
+! c               For water cycle, a typical dust size is assumed:
+! c               r(z)=r0*exp(-z/H) with r0=0.8 micron and H=18 km.
+! c               rfall(ig,l)=max( rice(ig,l)*1.5,rdust(ig,l) )
+!                 rfall(ig,l)=max( rice(ig,l)*(1.+nuice_sed)**3.,
+!      &                           rdust(ig,l) )
+  c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
++ c mars commente pour l'instant               rfall(ig,l)=20.e-6
+                  rfall(ig,l)=min(rfall(ig,l),1.e-4)
+                  enddo
+                enddo ! of do l=1,nlay
+! c           endif
+              call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+!      &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi(1,1,iq),
+!      &      wq,1.0)
+! c           Tendencies
+! c           ~~~~~~~~~~
+!             do ig=1,ngrid 
+!               pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+!             end do
+! c -----------------------------------------------------------------
+! c         GENERAL CASE
+! c -----------------------------------------------------------------
+            else
+              call newsedim(ngrid,nlay,1,ptimestep,
+!      &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),
+!      &      zqi(1,1,iq),wq,1.0)
+! c           Tendencies
+! c           ~~~~~~~~~~
+              do ig=1,ngrid 
+                pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+              end do
++           endif ! of if doubleq and if water
++ c -----------------------------------------------------------------
+  
+            DO l = 1, nlay
+              DO ig=1,ngrid
+!               pdqsed(ig,l,iq)=(zqi(ig,l,iq)-
+       $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+              ENDDO
+            ENDDO
+  
+          endif ! of if(radius(iq).gt.1.e-9)
++ c =================================================================
+        enddo ! of do iq=1,nq
+   
+        RETURN
+*** libf/phymars/datafile.h	Mon Jan 24 12:16:55 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/datafile.h	Thu Sep 23 10:56:42 2004
+***************
+*** 4,10 ****
+  !  Address of the directory containing tables of data needed by the GCM    
+  
+        character (len=100) :: datafile
+- !! path to WRF data
+         data datafile /'/u/forget/WWW/datagcm/datafile'/
+! !       data datafile /'/d5/aslmd/LMD_MM_MARS_DATA/dust'/
+  !-----------------------------------------------------------------------
+--- 4,9 ----
+  !  Address of the directory containing tables of data needed by the GCM    
+  
+        character (len=100) :: datafile
+        data datafile /'/u/forget/WWW/datagcm/datafile'/
+! !     data datafile /'/home/forget/datafile'/
+  !-----------------------------------------------------------------------
+*** libf/phymars/convadj.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/convadj.F	Tue Dec 14 10:42:17 2010
+***************
+*** 1,24 ****
+        SUBROUTINE convadj(ngrid,nlay,nq,ptimestep,
+!      S                   pplay,pplev,ppopsk,
+!      $                   pu,pv,ph,pq,
+!      $                   pdufi,pdvfi,pdhfi,pdqfi,
+!      $                   pduadj,pdvadj,pdhadj,
+!      $                   pdqadj)
+        IMPLICIT NONE
+  
+! c=======================================================================
+! c
+! c   ajustement convectif sec
+! c   on ajoute les tendances pdhfi au profil pdh avant l'ajustement
+! c   SPECIAL VERSION : if one tracer is CO2, take into account the
+! c   Molecular mass variation (e.g. when CO2 condense) to trigger
+! c   convection  F. Forget 01/2005
+! c
+! c=======================================================================
+! 
+! c-----------------------------------------------------------------------
+! c   declarations:
+! c   -------------
+  
+  #include "dimensions.h"
+  #include "dimphys.h"
+--- 1,31 ----
+        subroutine convadj(ngrid,nlay,nq,ptimestep,
+!      &                   pplay,pplev,ppopsk,
+!      &                   pu,pv,ph,pq,
+!      &                   pdufi,pdvfi,pdhfi,pdqfi,
+!      &                   pduadj,pdvadj,pdhadj,
+!      &                   pdqadj)
+! 
+        implicit none
+  
+! !==================================================================
+! !     
+! !     Purpose
+! !     -------
+! !     Calculates dry convective adjustment. If one tracer is CO2,
+! !     we take into account the molecular mass variation (e.g. when
+! !     CO2 condenses) to trigger convection (F. Forget 01/2005)
+! !
+! !     Authors
+! !     -------
+! !     Original author unknown.
+! !     Modif. 2005 by F. Forget.
+! !     Modif. 2010 by R. Wordsworth
+! !     
+! !==================================================================
+! 
+! !     ------------
+! !     Declarations
+! !     ------------
+  
+  #include "dimensions.h"
+  #include "dimphys.h"
+***************
+*** 27,50 ****
+  #include "tracer.h"
+  
+  
+! c   arguments:
+! c   ----------
+  
+!       INTEGER ngrid,nlay
+!       REAL ptimestep
+!       REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
+!       REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
+!       REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
+!       REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
+! 
+! c    Traceurs :
+!       integer nq
+!       real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+!       real pdqadj(ngrid,nlay,nq)
+  
+  
+! c   local:
+! c   ------
+  
+        INTEGER ig,i,l,l1,l2,jj
+        INTEGER jcnt, jadrs(ngridmx)
+--- 34,62 ----
+  #include "tracer.h"
+  
+  
+! !     Arguments
+! !     ---------
+  
+!       INTEGER,intent(in) :: ngrid,nlay
+!       REAL,intent(in) :: ptimestep
+!       REAL,intent(in) :: ph(ngrid,nlay)
+!       REAL,intent(in) :: pdhfi(ngrid,nlay)
+!       REAL,intent(out) :: pdhadj(ngrid,nlay)
+!       REAL,intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+!       REAL,intent(in) :: ppopsk(ngrid,nlay)
+!       REAL,intent(in) :: pu(ngrid,nlay),pdufi(ngrid,nlay)
+!       REAL,intent(out) :: pduadj(ngrid,nlay)
+!       REAL,intent(in) :: pv(ngrid,nlay),pdvfi(ngrid,nlay)
+!       REAL,intent(out) :: pdvadj(ngrid,nlay)
+! 
+! !     Tracers
+!       integer,intent(in) :: nq
+!       real,intent(in) :: pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+!       real,intent(out) :: pdqadj(ngrid,nlay,nq)
+  
+  
+! !     Local
+! !     -----
+  
+        INTEGER ig,i,l,l1,l2,jj
+        INTEGER jcnt, jadrs(ngridmx)
+***************
+*** 56,71 ****
+        REAL zh2(ngridmx,nlayermx), zhc(ngridmx,nlayermx)
+        REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+        
+! 
+! c    Traceurs :
+        INTEGER iq,ico2
+        save ico2
+        REAL zq(ngridmx,nlayermx,nqmx), zq2(ngridmx,nlayermx,nqmx)
+        REAL zqm(nqmx),zqco2m
+        real m_co2, m_noco2, A , B
+        save A, B
+- c    Temporaire (for diagnostic)
+- c      REAL diag_alpha(ngridmx)
+  
+        real mtot1, mtot2 , mm1, mm2
+         integer l1ref, l2ref
+--- 68,80 ----
+        REAL zh2(ngridmx,nlayermx), zhc(ngridmx,nlayermx)
+        REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+  
+! !     Tracers
+        INTEGER iq,ico2
+        save ico2
+        REAL zq(ngridmx,nlayermx,nqmx), zq2(ngridmx,nlayermx,nqmx)
+        REAL zqm(nqmx),zqco2m
+        real m_co2, m_noco2, A , B
+        save A, B
+  
+        real mtot1, mtot2 , mm1, mm2
+         integer l1ref, l2ref
+***************
+*** 73,103 ****
+        save firstcall
+        data firstcall/.true./
+  
+!       EXTERNAL SCOPY
+! c
+! c-----------------------------------------------------------------------
+! c   initialisation:
+! c   ---------------
+! c
+        IF (firstcall) THEN 
+          IF(ngrid.NE.ngridmx) THEN
+             PRINT*
+!            PRINT*,'STOP dans convadj'
+             PRINT*,'ngrid    =',ngrid
+             PRINT*,'ngridmx  =',ngridmx
+          ENDIF
+          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
+               end if
+--- 82,113 ----
+        save firstcall
+        data firstcall/.true./
+  
+! !     for conservation test
+!       real masse,cadjncons
+! 
+! !     --------------
+! !     Initialisation
+! !     --------------
+! 
+        IF (firstcall) THEN 
+          IF(ngrid.NE.ngridmx) THEN
+             PRINT*
+!            PRINT*,'STOP in convadj'
+             PRINT*,'ngrid    =',ngrid
+             PRINT*,'ngridmx  =',ngridmx
+          ENDIF
+          ico2=0
+          if (tracer) then
+! !     Prepare Special treatment if one of the tracers 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)   
+! !               Compute A and B coefficient use to compute
+! !               mean molecular mass Mair defined by
+! !               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
+! !               1/Mair = A*q(ico2) + B
+                  A =(1/m_co2 - 1/m_noco2)
+                  B=1/m_noco2
+               end if
+***************
+*** 106,124 ****
+          firstcall=.false.
+        ENDIF ! of IF (firstcall)
+  
+- c
+- c-----------------------------------------------------------------------
+- c   detection des profils a modifier:
+- c   ---------------------------------
+- c   si le profil est a modifier
+- c   (i.e. ph(niv_sup) < ph(niv_inf) )
+- c   alors le tableau "vtest" est mis a .TRUE. ;
+- c   sinon, il reste a sa valeur initiale (.FALSE.)
+- c   cette operation est vectorisable
+- c   On en profite pour copier la valeur initiale de "ph"
+- c   dans le champ de travail "zh"
+- 
+- 
+        DO l=1,nlay
+           DO ig=1,ngrid
+              zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
+--- 116,121 ----
+***************
+*** 137,171 ****
+          ENDDO
+        end if
+  
+! 
+!       CALL scopy(ngrid*nlay,zh,1,zh2,1)
+!       CALL scopy(ngrid*nlay,zu,1,zu2,1)
+!       CALL scopy(ngrid*nlay,zv,1,zv2,1)
+!       CALL scopy(ngrid*nlay*nq,zq,1,zq2,1)
+  
+        DO ig=1,ngrid
+          vtest(ig)=.FALSE.
+        ENDDO
+! c
+        if (ico2.ne.0) then
+! c        Special case if one of the tracer is CO2 gas
+           DO l=1,nlay
+             DO ig=1,ngrid
+               zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+             ENDDO
+           ENDDO
+         else
+!           CALL scopy(ngrid*nlay,zh2,1,zhc,1)
+         end if
+  
+!        
+! 
+        DO l=2,nlay
+          DO ig=1,ngrid
+            IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.TRUE.
+          ENDDO
+        ENDDO
+! c
+        jcnt=0
+        DO ig=1,ngrid
+           IF(vtest(ig)) THEN
+--- 134,172 ----
+          ENDDO
+        end if
+  
+!       zh2(:,:)=zh(:,:)
+!       zu2(:,:)=zu(:,:)
+!       zv2(:,:)=zv(:,:)
+!       zq2(:,:,:)=zq(:,:,:)
+! 
+! !     -----------------------------
+! !     Detection of unstable columns
+! !     -----------------------------
+! !     If ph(above) < ph(below) we set vtest=.true.
+  
+        DO ig=1,ngrid
+          vtest(ig)=.false.
+        ENDDO
+! 
+        if (ico2.ne.0) then
+! !     Special case if one of the tracers is CO2 gas
+           DO l=1,nlay
+             DO ig=1,ngrid
+               zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+             ENDDO
+           ENDDO
+         else
+!           zhc(:,:)=zh2(:,:)
+         end if
+  
+! !     Find out which grid points are convectively unstable
+        DO l=2,nlay
+          DO ig=1,ngrid
+            IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.true.
+          ENDDO
+        ENDDO
+! 
+! !     Make a list of them
+        jcnt=0
+        DO ig=1,ngrid
+           IF(vtest(ig)) THEN
+***************
+*** 175,189 ****
+        ENDDO
+  
+  
+! c-----------------------------------------------------------------------
+! c  Ajustement des "jcnt" profils instables indices par "jadrs":
+! c  ------------------------------------------------------------
+! c
+        DO jj = 1, jcnt   ! loop on every convective grid point
+! c
+            i = jadrs(jj)
+   
+! c   Calcul des niveaux sigma sur cette colonne
+            DO l=1,nlay+1
+              sig(l)=pplev(i,l)/pplev(i,1)
+          
+--- 176,190 ----
+        ENDDO
+  
+  
+! !     ---------------------------------------------------------------
+! !     Adjustment of the "jcnt" unstable profiles indicated by "jadrs"
+! !     ---------------------------------------------------------------
+! 
+        DO jj = 1, jcnt   ! loop on every convective grid point
+! 
+            i = jadrs(jj)
+   
+! !     Calculate sigma in this column
+            DO l=1,nlay+1
+              sig(l)=pplev(i,l)/pplev(i,1)
+          
+***************
+*** 193,209 ****
+              sdsig(l)=ppopsk(i,l)*dsig(l)
+           ENDDO
+            l2 = 1
+! c
+! c      -- boucle de sondage vers le haut
+! c
+! cins$     Loop  vers le haut sur l2
+            DO
+- c
+              l2 = l2 + 1
+              IF (l2 .GT. nlay) EXIT
+              IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+   
+! c          -- l2 est le niveau le plus haut de la colonne instable
+   
+                l1 = l2 - 1
+                l  = l1
+--- 194,208 ----
+              sdsig(l)=ppopsk(i,l)*dsig(l)
+           ENDDO
+            l2 = 1
+! 
+! !     Test loop upwards on l2
+! 
+            DO
+              l2 = l2 + 1
+              IF (l2 .GT. nlay) EXIT
+              IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+   
+! !     l2 is the highest level of the unstable column
+   
+                l1 = l2 - 1
+                l  = l1
+***************
+*** 211,221 ****
+                zdsm = dsig(l2)
+                zhm = zh2(i, l2)
+                if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+! c
+! c          -- boucle de sondage vers le bas
+! c             Loop
+                DO
+- c
+                  zsm = zsm + sdsig(l)
+                  zdsm = zdsm + dsig(l)
+                  zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+--- 210,219 ----
+                zdsm = dsig(l2)
+                zhm = zh2(i, l2)
+                if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+! 
+! !     Test loop downwards
+! 
+                DO
+                  zsm = zsm + sdsig(l)
+                  zdsm = zdsm + dsig(l)
+                  zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+***************
+*** 227,233 ****
+                    zhmc = zhm
+                  end if
+   
+! c            -- doit on etendre la colonne vers le bas ?
+   
+                  down = .FALSE.
+                  IF (l1 .NE. 1) THEN    !--  and then
+--- 225,231 ----
+                    zhmc = zhm
+                  end if
+   
+! !     do we have to extend the column downwards?
+   
+                  down = .false.
+                  IF (l1 .ne. 1) then    !--  and then
+***************
+*** 236,241 ****
+--- 234,241 ----
+                    END IF
+                  END IF
+   
++                 ! this could be a problem...
++ 
+                  if (down) then
+   
+                    l1 = l1 - 1
+***************
+*** 243,264 ****
+   
+                  ELSE
+   
+! c              -- peut on etendre la colonne vers le haut ?
+   
+                    IF (l2 .EQ. nlay) EXIT
+   
+                    IF (zhc(i, l2+1) .GE. zhmc) EXIT
+! c
+                    l2 = l2 + 1
+                    l  = l2
+! c
+!                 END IF
+! c
+! cins$         End Loop
+!               ENDDO
+! c
+! c          -- nouveau profil : constant (valeur moyenne)
+! c
+                zalpha=0.
+                zum=0.
+                zvm=0.
+--- 243,264 ----
+   
+                  else
+   
+! !     can we extend the column upwards?
+   
+                    if (l2 .eq. nlay) exit
+   
+                    if (zhc(i, l2+1) .ge. zhmc) exit
+! 
+                    l2 = l2 + 1
+                    l  = l2
+! 
+!                 end if ! of if (down)
+! 
+!               enddo ! of do ! Test loop forward
+! 
+! !     New constant profile (average value)
+! 
+! 
+                zalpha=0.
+                zum=0.
+                zvm=0.
+***************
+*** 273,284 ****
+                    zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                  endif
+                  zh2(i, l) = zhm
+!                 zum=zum+dsig(l)*zu(i,l)
+!                 zvm=zvm+dsig(l)*zv(i,l)
+                  do iq=1,nq
+!                    zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+                  end do
+!               ENDDO
+                zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+                zum=zum/(sig(l1)-sig(l2+1))
+                zvm=zvm/(sig(l1)-sig(l2+1))
+--- 273,295 ----
+                    zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                  endif
+                  zh2(i, l) = zhm
+! !     modifs by RDW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                 zum=zum+dsig(l)*zu2(i,l)
+!                 zvm=zvm+dsig(l)*zv2(i,l)
+! !                zum=zum+dsig(l)*zu(i,l)
+! !                zvm=zvm+dsig(l)*zv(i,l)
+                  do iq=1,nq
+!                    zqm(iq) = zqm(iq)+dsig(l)*zq2(i,l,iq)
+! !                   zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 
+! !     to conserve tracers/ KE, we must calculate zum, zvm and zqm using 
+! !     the up-to-date column values. If we do not do this, there are cases 
+! !     where convection stops at one level and starts at the next where we
+! !     can break conservation of stuff (particularly tracers) significantly.
+! 
+                  end do
+!               ENDDO ! of DO l = l1, l2
+                zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+                zum=zum/(sig(l1)-sig(l2+1))
+                zvm=zvm/(sig(l1)-sig(l2+1))
+***************
+*** 289,295 ****
+                IF(zalpha.GT.1.) THEN
+                   zalpha=1.
+                ELSE
+! c                IF(zalpha.LT.0.) STOP
+                   IF(zalpha.LT.1.e-4) zalpha=1.e-4
+                ENDIF
+  
+--- 300,306 ----
+                IF(zalpha.GT.1.) THEN
+                   zalpha=1.
+                ELSE
+! !                IF(zalpha.LT.0.) STOP
+                   IF(zalpha.LT.1.e-4) zalpha=1.e-4
+                ENDIF
+  
+***************
+*** 297,307 ****
+                   zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                   zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                   do iq=1,nq
+! c                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+                     zq2(i,l,iq)=zqm(iq)
+                   end do
+                ENDDO
+- c              diag_alpha(i)=zalpha  !temporaire
+                if (ico2.ne.0) then
+                  DO l=l1, l2
+                    zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+--- 308,317 ----
+                   zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                   zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                   do iq=1,nq
+! !                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+                     zq2(i,l,iq)=zqm(iq)
+                   end do
+                ENDDO
+                if (ico2.ne.0) then
+                  DO l=l1, l2
+                    zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+***************
+*** 310,322 ****
+  
+   
+                l2 = l2 + 1
+! c
+!             END IF   ! fin traitement instabilité entre l1 et l2. 
+! c                      On repart pour test à partir du l2 au dessus...
+!           ENDDO   ! End Loop sur l2 vers le haut 
+! c
+!       ENDDO
+! c
+        DO l=1,nlay
+          DO ig=1,ngrid
+            pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+--- 320,390 ----
+  
+  
+                l2 = l2 + 1
+! 
+!             END IF   ! End of l1 to l2 instability treatment
+!                      ! We now continue to test from l2 upwards
+! 
+!           ENDDO   ! End of upwards loop on l2
+! 
+! 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! !     check conservation
+!          cadjncons=0.0
+!          if(water)then
+!           iq    = igcm_h2o_vap
+!           do l = 1, nlay
+!             masse = (pplev(i,l) - pplev(i,l+1))/g
+!             cadjncons = cadjncons + 
+!      &           masse*(zq2(i,l,iq)-zq(i,l,iq))/ptimestep 
+!           end do
+!          endif
+! 
+!          if(cadjncons.lt.-1.e-6)then
+!             print*,'convadj has just crashed...'
+!             print*,'i  = ',i
+!             print*,'l1 = ',l1
+!             print*,'l2 = ',l2
+!             print*,'cadjncons        = ',cadjncons
+!          do l = 1, nlay
+!             print*,'dsig         = ',dsig(l)
+!          end do         
+!          do l = 1, nlay
+!             print*,'dsig         = ',dsig(l)
+!          end do
+!          do l = 1, nlay
+!             print*,'sig         = ',sig(l)
+!          end do
+!          do l = 1, nlay
+!             print*,'pplay(ig,:)         = ',pplay(i,l)
+!          end do
+!          do l = 1, nlay+1
+!             print*,'pplev(ig,:)         = ',pplev(i,l)
+!          end do
+!          do l = 1, nlay
+!             print*,'ph(ig,:)         = ',ph(i,l)
+!          end do
+!          do l = 1, nlay
+!             print*,'zh(ig,:)         = ',zh(i,l)
+!          end do
+!          do l = 1, nlay
+!             print*,'zh2(ig,:)        = ',zh2(i,l)
+!          end do
+!          do l = 1, nlay
+!             print*,'zq(ig,:,vap)     = ',zq(i,l,igcm_h2o_vap)
+!          end do
+!          do l = 1, nlay
+!             print*,'zq2(ig,:,vap)    = ',zq2(i,l,igcm_h2o_vap)
+!          end do
+!             print*,'zqm(vap)         = ',zqm(igcm_h2o_vap)
+!             print*,'jadrs=',jadrs
+! 
+!             call abort
+!          endif
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 
+!       ENDDO ! of DO jj = 1, jcnt   ! loop on every convective grid point
+! 
+! 
+        DO l=1,nlay
+          DO ig=1,ngrid
+            pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+***************
+*** 335,350 ****
+          end do 
+        end if
+  
+! c     outpu
+!       if (ngrid.eq.1) then
+!          ig=1
+!          iq =1 
+!          write(*,*)'**** l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+!          do l=nlay,1,-1
+!            write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+!          end do
+!       end if
+  
+  
+        RETURN
+        END
+--- 403,420 ----
+          end do 
+        end if
+  
+! 
+! !     output
+! !      if (ngrid.eq.1) then
+! !         ig=1
+! !         iq =1 
+! !         write(*,*)'**convadj: l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+! !         do l=nlay,1,-1
+! !           write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+! !         end do
+! !      end if
+  
+  
+        return
+        end
++       
+*** libf/phymars/def_var.F90	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/def_var.F90	Fri Sep  3 09:40:21 2010
+***************
+*** 8,13 ****
+--- 8,14 ----
+  ! NetCDF ID of the variable.
+  ! The variables' attributes 'title' (Note that 'long_name' would be more
+  ! appropriate) and 'units' are also set. 
++ ! Modifs: Aug2010 Ehouarn: enforce outputs to be real*4
+  
+  implicit none
+  
+***************
+*** 27,37 ****
+  ierr=NF_REDEF(nid)
+  
+  ! 2. Define the variable
+! #ifdef NC_DOUBLE
+! ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+! #else
+  ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+! #endif
+  if(ierr/=NF_NOERR) then
+     write(*,*) "def_var: Failed defining variable "//trim(name)
+     write(*,*) NF_STRERROR(ierr)
+--- 28,38 ----
+  ierr=NF_REDEF(nid)
+  
+  ! 2. Define the variable
+! !#ifdef NC_DOUBLE
+! !ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+! !#else
+  ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+! !#endif
+  if(ierr/=NF_NOERR) then
+     write(*,*) "def_var: Failed defining variable "//trim(name)
+     write(*,*) NF_STRERROR(ierr)
+*** libf/phymars/dimphys.h	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/dimphys.h	Wed Sep 17 16:14:03 2008
+***************
+*** 1,13 ****
+  !-----------------------------------------------------------------------
+  !   INCLUDE 'dimphys.h'
+  
+! 
+!          INTEGER, parameter :: wiim=60
+!          INTEGER, parameter :: wjjm=60
+!          INTEGER, PARAMETER :: ngridmx=3600
+!          INTEGER, parameter :: nlayermx=60
+!          INTEGER, PARAMETER :: nsoilmx=10
+! 	
+  !-----------------------------------------------------------------------
+- 
+- 	 
+--- 1,12 ----
+  !-----------------------------------------------------------------------
+  !   INCLUDE 'dimphys.h'
+  
+! ! ngridmx : number of horizontal grid points
+! ! note: the -1/jjm term will be 0; unless jj=1
+!       integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
+! ! nlayermx : number of atmospheric layers
+!       integer, parameter :: nlayermx = llm 
+! ! nsoilmx : number of subterranean layers
+! !EM: old soil routine:      integer, parameter :: nsoilmx = 10
+!       integer, parameter :: nsoilmx = 18 
+  !-----------------------------------------------------------------------
+*** libf/phymars/dimradmars.h	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/dimradmars.h	Fri Nov 26 17:30:39 2010
+***************
+*** 14,21 ****
+  
+        INTEGER  NFLEV,NDLON,NDLO2,ndomainsz
+  
+! !     parameter (ndomainsz=ngridmx)
+!       parameter (ndomainsz=(ngridmx-1)/20 + 1)
+  !     parameter (ndomainsz=(ngridmx-1)/5 + 1) 
+  
+        parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
+--- 14,21 ----
+  
+        INTEGER  NFLEV,NDLON,NDLO2,ndomainsz
+  
+!       parameter (ndomainsz=ngridmx)
+! !     parameter (ndomainsz=(ngridmx-1)/20 + 1)
+  !     parameter (ndomainsz=(ngridmx-1)/5 + 1) 
+  
+        parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
+***************
+*** 26,32 ****
+  ! (ex: naerkind=1 if you use one dust mode without ice ...)
+  ! (ex: naerkind=2 if you use one dust mode and active ice ...)
+        integer naerkind
+!       parameter (naerkind=1)
+  
+  ! Reference wavelengths used to compute reference optical depth (m)
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--- 26,32 ----
+  ! (ex: naerkind=1 if you use one dust mode without ice ...)
+  ! (ex: naerkind=2 if you use one dust mode and active ice ...)
+        integer naerkind
+!       parameter (naerkind=2)
+  
+  ! Reference wavelengths used to compute reference optical depth (m)
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+***************
+*** 74,81 ****
+  !   this parameter to 1 and convolution will be turned off during
+  !   the radiative calculations.
+  
+! !     INTEGER, PARAMETER :: nsizemax = 60
+!       INTEGER, PARAMETER :: nsizemax = 1
+  
+  ! Various initialisation for LW radiative code
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--- 74,81 ----
+  !   this parameter to 1 and convolution will be turned off during
+  !   the radiative calculations.
+  
+!       INTEGER, PARAMETER :: nsizemax = 60
+! !     INTEGER, PARAMETER :: nsizemax = 1
+  
+  ! Various initialisation for LW radiative code
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+*** libf/phymars/dustlift.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/dustlift.F	Tue Jun  8 14:58:39 2004
+***************
+*** 1,5 ****
+!       SUBROUTINE dustlift(ngrid,nlay,nq,rho,
+!      $                  pcdh_true,pcdh,co2ice,
+       $                  dqslift)
+        IMPLICIT NONE
+  
+--- 1,4 ----
+!       SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice,
+       $                  dqslift)
+        IMPLICIT NONE
+  
+***************
+*** 42,69 ****
+        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     ---------------------------------
+--- 41,47 ----
+        REAL ust,us
+        REAL stress_seuil
+        SAVE stress_seuil
+!       DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+  
+  
+  c     ---------------------------------
+*** libf/phymars/suaer.F90	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/suaer.F90	Tue Jan 25 10:59:18 2011
+***************
+*** 37,42 ****
+--- 37,43 ----
+  #include "dimphys.h"
+  #include "dimradmars.h"     
+  #include "yomaer.h"
++ #include "aerkind.h"
+  
+  ! Optical properties (read in external ASCII files)
+  INTEGER          :: nwvl     ! Number of wavelengths in
+***************
+*** 85,138 ****
+  ! Local saved variables:
+  
+  CHARACTER(LEN=30), DIMENSION(naerkind,2), SAVE :: file_id
+  !---- Please indicate the names of the optical property files below
+  !     Please also choose the reference wavelengths of each aerosol
+! !       naerkind=1, visible range:
+! !       file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff       !!***WRF: pour faire varier le rayon (experim)
+!         file_id(1,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM    !!***WRF: PAR DEFAUT 
+! !       file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE   !!***WRF: pour test JB
+! !       file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
+! !       file_id(1,1) = 'optprop_dustvis.dat'        !Clancy-Lee
+! !       naerkind=1, infrared:
+! !       file_id(1,2) = 'optprop_dustir_TM_n50.dat'  !M.Wolff
+!         file_id(1,2) = 'optprop_dustir_TM.dat'      !M.Wolff
+! !       file_id(1,2) = 'optprop_dustir_MW-MIE.dat'  !M.Wolff MIE
+! !       file_id(1,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
+! !       naerkind=1, visible range:
+!         longrefvis(1)=0.67E-6
+  !                     For dust: change readtesassim accordingly;
+! !       naerkind=1, infrared:
+!         longrefir(1)=9.3E-6
+!       IF (activice) THEN
+! !       naerkind=2, visible range:
+!         file_id(2,1) = 'optprop_icevis_n30.dat'
+! !       file_id(2,1) = 'optprop_icevis.dat'
+! !       naerkind=2, infrared:
+!         file_id(2,2) = 'optprop_iceir_n30.dat'
+! !       file_id(2,2) = 'optprop_iceir.dat'
+! !       naerkind=2, visible range:
+!         longrefvis(2)=1.5E-6  ! 1.5um OMEGA/MEx
+! !       naerkind=2, infrared:
+!         longrefir(2)=12.1E-6  ! 825cm-1 TES/MGS
+!       ENDIF
+! !------------------------------------------------------------------
+  
+  ! Initializations:
+  
+! call zerophys(nsizemax*2*naerkind,radiustab)
+  
+! call zerophys(nsizemax*naerkind*nsun,gvis)
+! call zerophys(nsizemax*naerkind*nsun,omegavis)
+! call zerophys(nsizemax*naerkind*nsun,QVISsQREF)
+! 
+! call zerophys(nsizemax*naerkind*nir,gIR)
+! call zerophys(nsizemax*naerkind*nir,omegaIR)
+! call zerophys(nsizemax*naerkind*nir,QIRsQREF)
+! 
+! call zerophys(nsizemax*naerkind,QREFvis)
+! call zerophys(nsizemax*naerkind,QREFir)
+! call zerophys(nsizemax*naerkind,omegaREFvis)
+! call zerophys(nsizemax*naerkind,omegaREFir)
+  
+  DO iaer = 1, naerkind ! Loop on aerosol kind
+    DO idomain = 1, 2   ! Loop on radiation domain (VIS or IR)
+--- 86,177 ----
+  ! Local saved variables:
+  
+  CHARACTER(LEN=30), DIMENSION(naerkind,2), SAVE :: file_id
++ 
++ !==================================================================
+  !---- Please indicate the names of the optical property files below
+  !     Please also choose the reference wavelengths of each aerosol
+! 
+!       DO iaer = 1, naerkind ! Loop on aerosol kind
+!         aerkind: SELECT CASE (name_iaer(iaer))
+! !==================================================================
+!         CASE("dust_conrath") aerkind      ! Typical dust profile
+! !==================================================================
+! !       Visible domain:
+!         file_id(iaer,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM
+! !       file_id(iaer,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
+! !       file_id(iaer,1) = 'optprop_dustvis.dat'        !Clancy-Lee
+! !       Infrared domain:
+!         file_id(iaer,2) = 'optprop_dustir_TM.dat'      !M.Wolff TM
+! !       file_id(iaer,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
+! !       Reference wavelength in the visible:
+!         longrefvis(iaer)=0.67E-6
+  !                     For dust: change readtesassim accordingly;
+! !       Reference wavelength in the infrared:
+!         longrefir(iaer)=9.3E-6
+! !==================================================================
+!         CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+! !==================================================================
+! !       Visible domain:
+!         file_id(iaer,1) = 'optprop_dustvis_TM_n50.dat' !T-Matrix
+! !       file_id(iaer,1) = 'optprop_dustvis_n50.dat'    !Mie
+! !       Infrared domain:
+!         file_id(iaer,2) = 'optprop_dustir_n50.dat'     !Mie
+! !       Reference wavelength in the visible:
+!         longrefvis(iaer)=0.67E-6
+! !       If not equal to 0.67e-6 -> change readtesassim accordingly;
+! !       Reference wavelength in the infrared:
+!         longrefir(iaer)=9.3E-6
+! !==================================================================
+!         CASE("dust_submicron") aerkind   ! Small dust population
+! !==================================================================
+! !       Visible domain:
+!         file_id(iaer,1) = 'optprop_dustvis_01um_TM.dat' !M.Wolff
+! !       Infrared domain:
+!         file_id(iaer,2) = 'optprop_dustir_01um_TM.dat'  !M.Wolff
+! !       Reference wavelength in the visible:
+!         longrefvis(iaer)=0.67E-6
+! !       If not equal to 0.67e-6 -> change readtesassim accordingly;
+! !       Reference wavelength in the infrared:
+!         longrefir(iaer)=9.3E-6
+! !==================================================================
+!         CASE("h2o_ice") aerkind             ! Water ice crystals
+! !==================================================================
+! !       Visible domain:
+!         file_id(iaer,1) = 'optprop_icevis_n30.dat' !Warren
+! !       file_id(iaer,1) = 'optprop_icevis.dat'     !Warren
+! !       Infrared domain:
+!         file_id(iaer,2) = 'optprop_iceir_n30.dat'  !Warren
+! !       file_id(iaer,2) = 'optprop_iceir.dat'      !Warren
+! !       Reference wavelength in the visible:
+!         longrefvis(iaer)=0.67E-6  ! 1.5um OMEGA/MEx
+! !       Reference wavelength in the infrared:
+!         longrefir(iaer)=12.1E-6  ! 825cm-1 TES/MGS
+! !==================================================================
+!         END SELECT aerkind
+! !==================================================================
+!         WRITE(*,*) "Scatterer: ",trim(name_iaer(iaer))
+!         WRITE(*,*) "  corresponding files: "
+!         WRITE(*,*) "VIS: ",trim(file_id(iaer,1))
+!         WRITE(*,*) "IR : ",trim(file_id(iaer,2))
+! !==================================================================
+!       ENDDO ! iaer (loop on aerosol kind)
+  
+  ! Initializations:
+  
+! radiustab(1:naerkind,1:2,1:nsizemax)=0
+  
+! gvis(1:nsun,1:naerkind,1:nsizemax)=0
+! omegavis(1:nsun,1:naerkind,1:nsizemax)=0
+! QVISsQREF(1:nsun,1:naerkind,1:nsizemax)=0
+! 
+! gIR(1:nir,1:naerkind,1:nsizemax)=0
+! omegaIR(1:nir,1:naerkind,1:nsizemax)=0
+! QIRsQREF(1:nir,1:naerkind,1:nsizemax)=0
+! 
+! QREFvis(1:naerkind,1:nsizemax)=0
+! QREFir(1:naerkind,1:nsizemax)=0
+! omegaREFvis(1:naerkind,1:nsizemax)=0
+! omegaREFir(1:naerkind,1:nsizemax)=0
+  
+  DO iaer = 1, naerkind ! Loop on aerosol kind
+    DO idomain = 1, 2   ! Loop on radiation domain (VIS or IR)
+***************
+*** 279,284 ****
+--- 318,331 ----
+    epref=1.E+0
+  
+  DO isize=1,nsize(iaer,idomain)
++ ! test that there is enough room to store the data
++  if (isize.gt.nsizemax) then
++    write(*,*) "suaer: Error ! nsizemax is too small!"
++    write(*,*) "       nsizemax=",nsizemax
++    write(*,*) "       you must increase the value of nsizemax"
++    write(*,*) "       in dimradmars.h !"
++    stop
++  endif
+  ! ------------------------------------------------
+  ! 2.2 Save the particle sizes
+    radiustab(iaer,idomain,isize)=radiusdyn(isize)
+***************
+*** 359,365 ****
+  
+  ! 2.5 Computing  <QIR>/Qext(longrefvis)
+  
+!   DO iir=1,4
+      WRITE(*,*) 'QIRsQREFir Channel ',iir,': ',epav(iir)
+      epav(iir)=  epav(iir) * QREFir(iaer,isize) / &
+                              QREFvis(iaer,isize)
+--- 406,412 ----
+  
+  ! 2.5 Computing  <QIR>/Qext(longrefvis)
+  
+!   DO iir=1,nir-1
+      WRITE(*,*) 'QIRsQREFir Channel ',iir,': ',epav(iir)
+      epav(iir)=  epav(iir) * QREFir(iaer,isize) / &
+                              QREFvis(iaer,isize)
+*** libf/phymars/aeropacity.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/aeropacity.F	Mon Jan 24 16:33:42 2011
+***************
+*** 1,5 ****
+!       SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+!      &    tauref,tau,aerosol,reffrad,
+       &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                     
+  ! to use  'getin'
+--- 1,5 ----
+!       SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+!      &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+       &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                     
+  ! to use  'getin'
+***************
+*** 52,57 ****
+--- 52,58 ----
+  #include "yomaer.h"
+  #include "tracer.h"
+  #include "planete.h"
++ #include "aerkind.h"
+  
+  c-----------------------------------------------------------------------
+  c
+***************
+*** 67,73 ****
+--- 68,76 ----
+        REAL pq(ngrid,nlayer,nq)
+        REAL tauref(ngrid), tau(ngrid,naerkind)
+        REAL aerosol(ngrid,nlayer,naerkind)
++       REAL dsodust(ngridmx,nlayermx)
+        REAL reffrad(ngrid,nlayer,naerkind)
++       REAL nueffrad(ngrid,nlayer,naerkind)
+        REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+        REAL QREFir3d(ngridmx,nlayermx,naerkind)
+        REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+***************
+*** 80,86 ****
+        real topdust(ngridmx)
+        real zlsconst, zp
+        real taueq,tauS,tauN
+-       real r0,reff,coefsize
+  c     Mean Qext(vis)/Qext(ir) profile
+        real msolsir(nlayermx,naerkind)
+  c     Mean Qext(ir)/Qabs(ir) profile
+--- 83,88 ----
+***************
+*** 99,110 ****
+--- 101,120 ----
+                                 !   reference wavelength using
+                                 !   Qabs instead of Qext
+                                 !   (direct comparison with TES)
++       REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
++       REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
++                                    !   (particules kg-1)
++       REAL qtot(ngridmx)           ! Dust column (kg m-2)
+  c
+  c   local saved variables
+  c   ---------------------
+  
+        REAL topdust0(ngridmx) 
+        SAVE topdust0
++ c     Level under which the dust mixing ratio is held constant
++ c       when computing the dust opacity in each layer
++ c       (this applies when doubleq and active are true)
++       INTEGER, PARAMETER :: cstdustlevel = 7
+  
+        LOGICAL firstcall
+        DATA firstcall/.true./
+***************
+*** 113,142 ****
+  ! indexes of water ice and dust tracers:
+        INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+        INTEGER,SAVE :: i_ice=0  ! water ice
+!       CHARACTER(LEN=20) :: tracername ! to temporarly store text
+  
+! c **********************************************************
+! c    Declaration special local dust storm TASI   
+!          logical localstorm
+!          real taulocref,ztoploc,radloc,lonloc,latloc
+!          integer ltoploc
+!          real tauloc ! diagnostic only
+! c **********************************************************
+! 
+! 
+! 
+! 
+! 
+!       call zerophys(ngrid*naerkind,tau)
+  
+  ! identify tracers
+  
+        IF (firstcall) THEN
+          ! identify tracers which are dust
+          i=0
+          DO iq=1,nq
+!           tracername=noms(iq)
+!           IF (tracername(1:4).eq."dust") THEN
+            i=i+1
+            nqdust(i)=iq
+            ENDIF
+--- 123,153 ----
+  ! indexes of water ice and dust tracers:
+        INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+        INTEGER,SAVE :: i_ice=0  ! water ice
+!       CHARACTER(LEN=20) :: txt ! to temporarly store text
+!       CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! ! indexes of dust scatterers:
+!       INTEGER,SAVE :: iaerdust(naerkind)
+!       INTEGER,SAVE :: naerdust ! number of dust scatterers
+  
+!       tau(1:ngrid,1:naerkind)=0
+  
+  ! identify tracers
+  
+        IF (firstcall) THEN
++         ! identify scatterers that are dust
++         naerdust=0
++         DO iaer=1,naerkind
++           txt=name_iaer(iaer)
++           IF (txt(1:4).eq."dust") THEN
++             naerdust=naerdust+1
++             iaerdust(naerdust)=iaer
++           ENDIF
++         ENDDO
+          ! identify tracers which are dust
+          i=0
+          DO iq=1,nq
+!           txt=noms(iq)
+!           IF (txt(1:4).eq."dust") THEN
+            i=i+1
+            nqdust(i)=iq
+            ENDIF
+***************
+*** 154,161 ****
+          END DO
+  
+  c       typical profile of solsir and (1-w)^(-1):
+!         call zerophys(nlayer*naerkind,msolsir)
+!         call zerophys(nlayer*naerkind,mqextsqabs)
+          WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+          DO iaer = 1, naerkind ! Loop on aerosol kind
+            WRITE(*,*) "Aerosol # ",iaer
+--- 165,172 ----
+          END DO
+  
+  c       typical profile of solsir and (1-w)^(-1):
+!         msolsir(1:nlayer,1:naerkind)=0
+!         mqextsqabs(1:nlayer,1:naerkind)=0
+          WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+          DO iaer = 1, naerkind ! Loop on aerosol kind
+            WRITE(*,*) "Aerosol # ",iaer
+***************
+*** 182,199 ****
+  
+        END IF
+  
+-       DO iaer = 1, naerkind ! Loop on aerosol kind
+- c     --------------------------------------------
+-         aerkind: SELECT CASE (iaer)
+- c==================================================================
+-         CASE(1) aerkind                             ! Dust (iaer=1)
+- c==================================================================
+- 
+- c  -------------------------------------------------------------
+- c     1) Prescribed dust  (if tracer=F or active=F)
+- c  -------------------------------------------------------------
+-       IF ((.not.tracer) .or. (.not.active)) THEN 
+- 
+  c       Vertical column optical depth at 700.Pa 
+  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          IF(iaervar.eq.1) THEN 
+--- 193,198 ----
+***************
+*** 226,235 ****
+               tauref(ig)= tauS +
+       &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+             end do
+- 
+          ELSE IF ((iaervar.eq.4).or.
+!      &           ((iaervar.ge.24).and.(iaervar.le.26)).or.
+!      &           (iaervar.eq.6).or.(iaervar.eq.7))
+       &       THEN  ! << "TES assimilated dust scenarios >>
+             call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+  
+--- 225,232 ----
+            tauref(ig)= tauS +
+       &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+          end do
+        ELSE IF ((iaervar.eq.4).or.
+!      &        ((iaervar.ge.24).and.(iaervar.le.26)))
+       &     THEN  ! << "TES assimilated dust scenarios >>
+          call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+  
+***************
+*** 248,253 ****
+--- 245,261 ----
+          stop 'problem with iaervar in aeropacity.F'
+        ENDIF
+  
++ c -----------------------------------------------------------------
++ c Computing the opacity in each layer
++ c -----------------------------------------------------------------
++ 
++       DO iaer = 1, naerkind ! Loop on aerosol kind
++ c     --------------------------------------------
++         aerkind: SELECT CASE (name_iaer(iaer))
++ c==================================================================
++         CASE("dust_conrath") aerkind      ! Typical dust profile
++ c==================================================================
++ 
+  c       Altitude of the top of the dust layer
+  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          zlsconst=SIN(ls-2.76)
+***************
+*** 266,274 ****
+              topdust(ig)=60.+18.*zlsconst
+       &                -(32+18*zlsconst)*sin(lati(ig))**4
+       &                 - 8*zlsconst*(sin(lati(ig)))**5
+-           !! Lilia : standart 1; 0.8; 1.2
+-             topdust(ig)=1.0*topdust(ig)
+-           !!
+            end do
+          endif
+  
+--- 274,279 ----
+***************
+*** 276,283 ****
+  c       Optical depth in each layer :
+  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(iddist.ge.1) then
+            expfactor=0.
+-           CALL zerophys(ngrid,taudusttmp)
+            DO l=1,nlayer
+              DO ig=1,ngrid
+  c             Typical mixing ratio profile 
+--- 280,287 ----
+  c       Optical depth in each layer :
+  c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(iddist.ge.1) then
++ 
+            expfactor=0.
+            DO l=1,nlayer
+              DO ig=1,ngrid
+  c             Typical mixing ratio profile 
+***************
+*** 292,403 ****
+                aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+       &          expfactor *
+       &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+- c             Scaling factor
+-               taudusttmp(ig)=taudusttmp(ig)+aerosol(ig,l,iaer)
+-             ENDDO
+-           ENDDO
+- 
+- c         Rescaling each layer to reproduce the choosen (or
+- c           assimilated) dust extinction opacity at visible
+- c           reference wavelength, which is originally scaled
+- c           to an equivalent 700Pa pressure surface.
+-           DO l=1,nlayer
+-             DO ig=1,ngrid
+-               aerosol(ig,l,iaer) = tauref(ig) *
+-      &                     pplev(ig,1) / 700.E0 *
+-      &                     aerosol(ig,l,iaer) / taudusttmp(ig)
+-             ENDDO
+-           ENDDO
+- 
+- c ***************************************************************
+- c    SPECIAL LOCAL DUST STORM TASI
+- c    We modify only aerosol calculated above where the local dust storm is 
+- 
+-       localstorm =  .true.
+-       if (localstorm) then
+-          taulocref = 2 !10  ! ref optical depth of the local dust storm
+-          ztoploc = 11    ! target pseudo-altitude of local storm (km)
+-          radloc = 4.     ! radius of dust storm (degree)
+-          lonloc=-3       ! center longitude of storm (deg)
+-          latloc=-2.      ! center latitude of storm (deg)
+- 
+-          DO ig=1,ngrid
+- c          Where is the dust storm:
+-            if (((lati(ig)*180./pi-latloc)**2 
+-      &       + (long(ig)*180./pi -lonloc)**2).le.(radloc**2))then
+- c             Computing where is the top level of the localstorm
+-               DO l=nlayer,1,-1
+-                 ltoploc=l+1
+-                 if(-10*log(pplev(ig,l)/pplev(ig,1)).lt.ztoploc)goto 88
+-               END DO
+-  88           continue
+-               DO l=1,ltoploc-1
+-                  aerosol(ig,l,1)=max(aerosol(ig,l,1),
+-      &                  taulocref* (pplev(ig,l)-pplev(ig,l+1))
+-      &                 /(pplev(ig,1)-pplev(ig,ltoploc)))
+-               END DO
+- 
+- c             diagnostic
+-               write(*,*)
+-               write(*,*) 'lat,lon',lati(ig)*180./pi,long(ig)*180./pi 
+-               write(*,*) 'true dustorm top pseudo-height (km) = ',
+-      &          -10*log(pplev(ig,ltoploc)/pplev(ig,1))
+- c             tauloc=0.
+- c             DO l=1,nlayer
+- c              tauloc = tauloc + aerosol(ig,l,1)
+- c              write(*,*) 'below ',
+- c    &          -10*log(pplev(ig,l+1)/pplev(ig,1)),
+- c    &         'km, tau=', tauloc 
+- c             ENDDO
+- 
+-            endif
+-          END DO
+-       endif
+- c ***************************************************************
+- 
+- 
+- 
+-           CALL zerophys(ngrid,taudustvis)
+-           CALL zerophys(ngrid,taudusttes)
+-           DO l=1,nlayer
+-             DO ig=1,ngrid
+-               taudustvis(ig) = taudustvis(ig) + aerosol(ig,l,iaer)
+-               taudusttes(ig) = taudusttes(ig) + aerosol(ig,l,iaer)*
+-      &          QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer)*
+-      &          ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+              ENDDO
+            ENDDO
+  
+- c         Outputs
+-           IF (ngrid.NE.1) THEN
+- !            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
+- !     &        ' ',2,taudusttes)
+-             if (callstats) then
+-               CALL wstats(ngridmx,'taudustTES','dust abs IR',
+-      &          ' ',2,taudusttes)
+-             endif
+-           ELSE
+-             CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
+-           ENDIF
+- 
+- c     changement dans le calcul de la distribution verticale          
+- c     dans le cas des scenarios de poussieres assimiles
+- c        if (iaervar.eq.4) THEN  ! TES
+- c        call zerophys(ngrid*naerkind,tau)
+- c
+- c        do l=1,nlayer
+- c           do ig=1,ngrid
+- c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+- c           end do
+- c        end do
+- c        do l=1,nlayer
+- c           do ig=1,ngrid
+- c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+- c     $     *(pplev(ig,1)/700)
+- c           end do
+- c        end do
+- c        endif
+- cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+          else if(iddist.eq.0) then   
+  c         old dust vertical distribution function (pollack90)
+            DO l=1,nlayer
+--- 296,304 ----
+***************
+*** 410,488 ****
+            ENDDO
+          end if
+  
+! c  ---------------------------------------------------------------------
+! c     2) Transported radiatively active dust  (if tracer=T and active=T)
+! c ----------------------------------------------------------------------
+!       ELSE  IF ((tracer) .and. (active)) THEN 
+! c     The dust opacity is computed from q
+! 
+! c     a) "doubleq" technique (transport of mass and number mixing ratio)
+! c        ~~~~~~~~~~~~~~~~~~~
+!        if(doubleq) then 
+! 
+!          call zerophys(ngrid*nlayer*naerkind,aerosol)
+  
+- c        Computing effective radius :
+           do  l=1,nlayer
+!            do ig=1, ngrid
+!               r0=
+!      &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+!               r0=min(max(r0,1.e-10),500.e-6)
+!               reff= ref_r0 * r0
+! cc           If  reff is small, the transported dust mean Qext
+! c            is reduced from the reference dust Qext by a factor "coefsize"
+! 
+!              coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+! 
+! cc              It is added 1.e-8 to pq to avoid low
+  
+!                 aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+!      &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+!      &          * (pq(ig,l,nqdust(1)))*
+! c               only one dust bin to use with doubleq
+!      &          (pplev(ig,l)-pplev(ig,l+1))/g
+!            end do
+!          end do
+!          call zerophys(ngrid,tauref)
+  
+- c     b) Size bin technique (each aerosol can contribute to opacity))
+- c        ~~~~~~~~~~~~~~~~~~
+-        else
+- c        The dust opacity is computed from q
+-          call zerophys(ngrid*nlayer*naerkind,aerosol)
+-          do iq=1,dustbin
+             do l=1,nlayer
+                do ig=1,ngrid
+! cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+! cc               It is added 1.e-8 to pq to avoid low
+!                  aerosol(ig,l,1)=aerosol(ig,l,1)+
+!      &           qextrhor(nqdust(iq))*(pq(ig,l,nqdust(iq))+1.e-8)*
+!      &           (pplev(ig,l)-pplev(ig,l+1))/g
+!               end do
+!            end do
+!          end do
+!          call zerophys(ngrid,tauref)
+!        end if  ! (doubleq)
+!       END IF   ! (dust scenario)
+! 
+  
+  c==================================================================
+!         CASE(2) aerkind               ! Water ice crystals (iaer=2)
+  c==================================================================
+  
+-       IF (water.AND.activice) THEN
+  c       1. Initialization
+!         CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))
+!         CALL zerophys(ngrid,taucloudvis)
+!         CALL zerophys(ngrid,taucloudtes)
+  c       2. Opacity calculation
+          DO ig=1, ngrid
+            DO l=1,nlayer
+!             aerosol(ig,l,iaer) =
+       &        (  0.75 * QREFvis3d(ig,l,iaer) /
+       &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+!      &        ( pq(ig,l,i_ice) + 1.E-8 ) *
+       &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+              taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+       &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+--- 311,386 ----
+            ENDDO
+          end if
+  
+! c==================================================================
+!         CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+! c        (transport of mass and number mixing ratio)
+! c==================================================================
+  
+            DO l=1,nlayer
+!             IF (l.LE.cstdustlevel) THEN
+! c           Opacity in the first levels is held constant to 
+! c             avoid unrealistic values due to constant lifting:
+!               DO ig=1,ngrid
+!                 aerosol(ig,l,iaer) = 
+!      &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+!      &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+!      &          pq(ig,cstdustlevel,igcm_dust_mass) *
+!      &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!               ENDDO
+!             ELSE
+!               DO ig=1,ngrid
+!                 aerosol(ig,l,iaer) =
+!      &          (  0.75 * QREFvis3d(ig,l,iaer) /
+!      &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+!      &          pq(ig,l,igcm_dust_mass) *
+!      &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!               ENDDO
+!             ENDIF
+!           ENDDO
+  
+! c==================================================================
+!         CASE("dust_submicron") aerkind   ! Small dust population
+! c==================================================================
+  
+            DO l=1,nlayer
++             IF (l.LE.cstdustlevel) THEN
++ c           Opacity in the first levels is held constant to 
++ c             avoid unrealistic values due to constant lifting:
+                DO ig=1,ngrid
+!                 aerosol(ig,l,iaer) = 
+!      &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+!      &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+!      &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+!      &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!               ENDDO
+!             ELSE
+!               DO ig=1,ngrid
+!                 aerosol(ig,l,iaer) = 
+!      &          (  0.75 * QREFvis3d(ig,l,iaer) /
+!      &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+!      &          pq(ig,l,igcm_dust_submicron) *
+!      &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!               ENDDO
+!             ENDIF
+!           ENDDO
+  
+  c==================================================================
+!         CASE("h2o_ice") aerkind             ! Water ice crystals
+  c==================================================================
+  
+  c       1. Initialization
+!         aerosol(1:ngrid,1:nlayer,iaer) = 0.
+!         taucloudvis(1:ngrid) = 0.
+!         taucloudtes(1:ngrid) = 0.
+  c       2. Opacity calculation
+          DO ig=1, ngrid
+            DO l=1,nlayer
+!             aerosol(ig,l,iaer) = max(1E-20,
+       &        (  0.75 * QREFvis3d(ig,l,iaer) /
+       &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+!      &        pq(ig,l,i_ice) *
+       &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
++      &                              )
+              taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+              taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+       &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+***************
+*** 491,520 ****
+          ENDDO
+  c       3. Outputs
+          IF (ngrid.NE.1) THEN
+! !          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+! !     &      ' ',2,taucloudtes)
+! !          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+! !     &      ' ',2,taucloudtes)
+!         ELSE
+!           CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+          ENDIF
+        ENDIF
+- 
+  c==================================================================
+          END SELECT aerkind
+  
+  c -----------------------------------------------------------------
+! c Column integrated visible optical depth in each point
+  c -----------------------------------------------------------------
+  
+        do l=1,nlayer
+           do ig=1,ngrid
+!                tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+!          end do
+!       end do
+  
+  c     -----------------------------------
+        ENDDO ! iaer (loop on aerosol kind)
+  
+        return
+        end 
+--- 389,528 ----
+          ENDDO
+  c       3. Outputs
+          IF (ngrid.NE.1) THEN
+!           CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+!      &      ' ',2,taucloudvis)
+!           CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+!      &      ' ',2,taucloudtes)
+!           IF (callstats) THEN
+!             CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+!      &        ' ',2,taucloudvis)
+!             CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+!      &        ' ',2,taucloudtes)
+            ENDIF
++         ELSE
++ c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+          ENDIF
+  c==================================================================
+          END SELECT aerkind
++ c     -----------------------------------
++       ENDDO ! iaer (loop on aerosol kind)
+  
+  c -----------------------------------------------------------------
+! c Rescaling each layer to reproduce the choosen (or assimilated)
+! c   dust extinction opacity at visible reference wavelength, which
+! c   is originally scaled to an equivalent 700Pa pressure surface.
+  c -----------------------------------------------------------------
+  
++       taudusttmp(1:ngrid)=0.
++       DO iaer=1,naerdust
+          DO l=1,nlayer
+            DO ig=1,ngrid
+! c           Scaling factor
+!             taudusttmp(ig) = taudusttmp(ig) + 
+!      &                       aerosol(ig,l,iaerdust(iaer))
+!           ENDDO
+!         ENDDO
+!       ENDDO
+!       DO iaer=1,naerdust
+!         DO l=1,nlayer
+!           DO ig=1,ngrid
+!             aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+!      &                   tauref(ig) *
+!      &                   pplev(ig,1) / 700.E0 *
+!      &                   aerosol(ig,l,iaerdust(iaer)) / 
+!      &                   taudusttmp(ig)
+!      &                                        )
+!           ENDDO
+!         ENDDO
+!       ENDDO
+  
++ c -----------------------------------------------------------------
++ c Computing the number of condensation nuclei
++ c -----------------------------------------------------------------
++       DO iaer = 1, naerkind ! Loop on aerosol kind
++ c     --------------------------------------------
++         aerkind2: SELECT CASE (name_iaer(iaer))
++ c==================================================================
++         CASE("dust_conrath") aerkind2     ! Typical dust profile
++ c==================================================================
++           DO l=1,nlayer
++             DO ig=1,ngrid
++               ccn(ig,l) = max(aerosol(ig,l,iaer) /
++      &                  pi / QREFvis3d(ig,l,iaer) *
++      &                  (1.+nueffrad(ig,l,iaer))**3. /
++      &                  reffrad(ig,l,iaer)**2. * g /
++      &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
++             ENDDO
++           ENDDO
++ c==================================================================
++         CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
++ c        (transport of mass and number mixing ratio)
++ c==================================================================
++           qtot(1:ngridmx) = 0.
++           DO l=1,nlayer
++             DO ig=1,ngrid
++               qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
++      &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
++               qtot(ig) = qtot(ig) + qdust(ig,l) *
++      &                   (pplev(ig,l)-pplev(ig,l+1)) / g
++               ccn(ig,l) = max( ( ref_r0 /
++      &                    reffrad(ig,l,iaer) )**3. *
++      &                    r3n_q * qdust(ig,l) ,1e-30)
++             ENDDO
++           ENDDO
++ c==================================================================
++         END SELECT aerkind2
+  c     -----------------------------------
+        ENDDO ! iaer (loop on aerosol kind)
+  
++ c -----------------------------------------------------------------
++ c Column integrated visible optical depth in each point
++ c -----------------------------------------------------------------
++       DO iaer=1,naerkind
++         do l=1,nlayer
++            do ig=1,ngrid
++              tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
++            end do
++         end do
++       ENDDO
++ c -----------------------------------------------------------------
++ c Density scaled opacity and column opacity output
++ c -----------------------------------------------------------------
++       dsodust(1:ngrid,1:nlayer) = 0.
++       DO iaer=1,naerdust
++         DO l=1,nlayermx
++           DO ig=1,ngrid
++             dsodust(ig,l) = dsodust(ig,l) +
++      &                      aerosol(ig,l,iaerdust(iaer)) * g /
++      &                      (pplev(ig,l) - pplev(ig,l+1))
++           ENDDO
++         ENDDO
++         IF (ngrid.NE.1) THEN
++           write(txt2,'(i1.1)') iaer
++           call WRITEDIAGFI(ngridmx,'taudust'//txt2,
++      &                    'Dust col opacity',
++      &                    ' ',2,tau(1,iaerdust(iaer)))
++           IF (callstats) THEN
++             CALL wstats(ngridmx,'taudust'//txt2,
++      &                 'Dust col opacity',
++      &                 ' ',2,tau(1,iaerdust(iaer)))
++           ENDIF
++         ENDIF
++       ENDDO
++ 
++       IF (ngrid.NE.1) THEN
++ c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
++ c    &                    'm2.kg-1',3,dsodust)
++         IF (callstats) THEN
++           CALL wstats(ngridmx,'dsodust',
++      &               'tau*g/dp',
++      &               'm2.kg-1',3,dsodust)
++         ENDIF
++ c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
++ c    &                    'part kg-1',3,ccn)
++       ELSE
++         CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
++       ENDIF
++ c -----------------------------------------------------------------
+        return
+        end 
+*** libf/phymars/inistats.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/inistats.F	Fri Sep  3 11:22:33 2010
+***************
+*** 26,35 ****
+        nsteppd=nint(daysec/dtphys)
+        write (*,*) 'nsteppd=',nsteppd
+        if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+!      ,   stop'Dans Instat:  1jour .ne. n pas physiques'
+  
+        if(mod(nsteppd,istime).ne.0)
+!      ,   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+  
+        istats=nsteppd/istime
+        write (*,*) 'istats=',istats
+--- 26,35 ----
+        nsteppd=nint(daysec/dtphys)
+        write (*,*) 'nsteppd=',nsteppd
+        if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+!      &   stop'Dans Instat:  1jour .ne. n pas physiques'
+  
+        if(mod(nsteppd,istime).ne.0)
+!      &   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+  
+        istats=nsteppd/istime
+        write (*,*) 'istats=',istats
+***************
+*** 55,74 ****
+        ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+  
+        ierr = NF_ENDDEF(nid)
+!       call def_var(nid,"Time","Time",
+!      .            "days since 0000-00-0 00:00:00",1,
+!      .            idim_time,nvarid,ierr)
+  ! Time is initialised later by mkstats subroutine
+  
+!       call def_var(nid,"latitude","latitude","degrees_north",1,
+!      .            idim_lat,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+  #endif
+!       call def_var(nid,"longitude","East longitude","degrees_east",1,
+!      .            idim_lon,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+  #else
+--- 55,74 ----
+        ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+  
+        ierr = NF_ENDDEF(nid)
+!       call def_var_stats(nid,"Time","Time",
+!      &            "days since 0000-00-0 00:00:00",1,
+!      &            idim_time,nvarid,ierr)
+  ! Time is initialised later by mkstats subroutine
+  
+!       call def_var_stats(nid,"latitude","latitude",
+!      &            "degrees_north",1,idim_lat,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+  #endif
+!       call def_var_stats(nid,"longitude","East longitude",
+!      &            "degrees_east",1,idim_lon,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+  #else
+***************
+*** 91,106 ****
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+  #endif 
+!       call def_var(nid,"aps","hybrid pressure at midlayers"," ",
+!      .            1,idim_llm,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+  #endif
+  
+!       call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+!      .            1,idim_llm,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+  #else 
+--- 91,106 ----
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+  #endif 
+!       call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ", 
+!      &            1,idim_llm,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+  #else
+        ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+  #endif
+  
+!       call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ", 
+!      &            1,idim_llm,nvarid,ierr)
+  #ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+  #else 
+***************
+*** 109,112 ****
+  
+        ierr=NF_CLOSE(nid)
+  
+!       end
+--- 109,113 ----
+  
+        ierr=NF_CLOSE(nid)
+  
+!       end subroutine inistats
+! 
+*** libf/phymars/initracer.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/initracer.F	Mon Jan 24 16:40:15 2011
+***************
+*** 48,65 ****
+        real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+        real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+        integer iq,ig,count
+!       real r0_lift , reff_lift
+        logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+        character(len=20) :: txt ! to store some text
+  
+  c-----------------------------------------------------------------------
+  c  radius(nqmx)      ! aerosol particle radius (m)
+  c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+- c  qext(nqmx)        ! Single Scat. Extinction coeff at 0.67 um
+  c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+  c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+  c  rho_dust          ! Mars dust density
+  c  rho_ice           ! Water ice density
+  c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+  c  varian            ! Characteristic variance of log-normal distribution
+  c-----------------------------------------------------------------------
+--- 49,71 ----
+        real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+        real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+        integer iq,ig,count
+!       real r0_lift , reff_lift, nueff_lift
+! c     Ratio of small over large dust particles (used when both 
+! c       doubleq and the submicron mode are active); In Montmessin
+! c       et al. (2002), a value of 25 has been deduced;
+!       real, parameter :: popratio = 25.
+        logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+        character(len=20) :: txt ! to store some text
+  
+  c-----------------------------------------------------------------------
+  c  radius(nqmx)      ! aerosol particle radius (m)
+  c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+  c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+  c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+  c  rho_dust          ! Mars dust density
+  c  rho_ice           ! Water ice density
++ c  nuice_ref         ! Effective variance nueff of the
++ c                    !   water-ice size distributions
+  c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+  c  varian            ! Characteristic variance of log-normal distribution
+  c-----------------------------------------------------------------------
+***************
+*** 157,184 ****
+  c     Test Dimensions tracers
+  c------------------------------------------------------------
+  
+!       if(photochem.or.thermochem) then
+!           if (water) then
+!               if ((dustbin+ncomp+2).ne.nqmx) then
+!                  print*,'initracer: tracer dimension problem:'
+!                  print*,"(dustbin+ncomp+2).ne.nqmx"
+!                  print*,"ncomp: ",ncomp
+!                  print*,"dustbin: ",dustbin
+!                  print*,"nqmx: ",nqmx
+!                  print*,'Change ncomp in chimiedata.h'
+!                endif
+!           else
+!               if ((dustbin+ncomp+1).ne.nqmx) then
+!                  print*,'initracer: tracer dimension problem:'
+!                  print*,"(dustbin+ncomp+1).ne.nqmx"
+!                  print*,"ncomp: ",ncomp
+!                  print*,"dustbin: ",dustbin
+!                  print*,"nqmx: ",nqmx
+!                  print*,'Change ncomp in chimiedata.h'
+!                  STOP
+!                endif
+!             endif
+!       endif
+  
+  c------------------------------------------------------------
+  c         NAME and molar mass of the tracer 
+--- 163,191 ----
+  c     Test Dimensions tracers
+  c------------------------------------------------------------
+  
+! ! Ehouarn: testing number of tracers is obsolete...
+! !      if(photochem.or.thermochem) then
+! !          if (water) then
+! !              if ((dustbin+ncomp+2).ne.nqmx) then
+! !                 print*,'initracer: tracer dimension problem:'
+! !                 print*,"(dustbin+ncomp+2).ne.nqmx"
+! !                 print*,"ncomp: ",ncomp
+! !                 print*,"dustbin: ",dustbin
+! !                 print*,"nqmx: ",nqmx
+! !                 print*,'Change ncomp in chimiedata.h'
+! !               endif
+! !          else
+! !              if ((dustbin+ncomp+1).ne.nqmx) then
+! !                 print*,'initracer: tracer dimension problem:'
+! !                 print*,"(dustbin+ncomp+1).ne.nqmx"
+! !                 print*,"ncomp: ",ncomp
+! !                 print*,"dustbin: ",dustbin
+! !                 print*,"nqmx: ",nqmx
+! !                 print*,'Change ncomp in chimiedata.h'
+! !                 STOP
+! !               endif
+! !            endif
+! !      endif
+  
+  c------------------------------------------------------------
+  c         NAME and molar mass of the tracer 
+***************
+*** 192,197 ****
+--- 199,205 ----
+        enddo
+        igcm_dust_mass=0
+        igcm_dust_number=0
++       igcm_dust_submicron=0
+        igcm_h2o_vap=0
+        igcm_h2o_ice=0
+        igcm_co2=0
+***************
+*** 234,239 ****
+--- 242,256 ----
+            endif
+          enddo
+        endif ! of if (doubleq)
++       if (submicron) then
++         do iq=1,nqmx
++           if (noms(iq).eq."dust_submicron") then
++             igcm_dust_submicron=iq
++             mmol(iq)=100.
++             count=count+1
++           endif
++         enddo
++       endif ! of if (submicron)
+        ! 2. find chemistry and water tracers
+        do iq=1,nqmx
+          if (noms(iq).eq."co2") then
+***************
+*** 357,362 ****
+--- 374,381 ----
+  
+        rho_dust=2500.  ! Mars dust density (kg.m-3)
+        rho_ice=920.    ! Water ice density (kg.m-3)
++       nuice_ref=0.1   ! Effective variance nueff of the
++                       ! water-ice size distributions
+  
+        if (doubleq) then
+  c       "doubleq" technique 
+***************
+*** 364,383 ****
+  c      (transport of mass and number mixing ratio)
+  c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+  
+!         if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+            write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+            write(*,*)'water= ',water,' doubleq= ',doubleq   
+          end if
+  
+!         varian=0.637    ! Characteristic variance    
+!         qext(igcm_dust_mass)=3.04   ! reference extinction at 0.67 um for ref dust
+!         qext(igcm_dust_number)=3.04 ! reference extinction at 0.67 um for ref dust
+          rho_q(igcm_dust_mass)=rho_dust
+          rho_q(igcm_dust_number)=rho_dust
+  
+  c       Intermediate calcul for computing geometric mean radius r0
+  c       as a function of mass and number mixing ratio Q and N
+! c       (r0 = (r3n_q * Q/ N)
+          r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+  
+  c       Intermediate calcul for computing effective radius reff
+--- 383,402 ----
+  c      (transport of mass and number mixing ratio)
+  c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+  
+!         if( (nqmx.lt.2).or.(water.and.(nqmx.lt.4)) ) then
+            write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+            write(*,*)'water= ',water,' doubleq= ',doubleq   
+          end if
+  
+!         nueff_lift = 0.5
+!         varian=sqrt(log(1.+nueff_lift))
+! 
+          rho_q(igcm_dust_mass)=rho_dust
+          rho_q(igcm_dust_number)=rho_dust
+  
+  c       Intermediate calcul for computing geometric mean radius r0
+  c       as a function of mass and number mixing ratio Q and N
+! c       (r0 = (r3n_q * Q/ N)^(1/3))
+          r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+  
+  c       Intermediate calcul for computing effective radius reff
+***************
+*** 387,395 ****
+          
+  c       lifted dust :
+  c       '''''''''''
+!         reff_lift = 3.e-6      !  Effective radius of lifted dust (m)
+          alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+!         alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+  
+          r0_lift = reff_lift/ref_r0
+          alpha_devil(igcm_dust_number)=r3n_q*
+--- 406,415 ----
+          
+  c       lifted dust :
+  c       '''''''''''
+!         reff_lift = 3.0e-6 !3.e-6 !Effective radius of lifted dust (m)
+          alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+! c       alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+!         alpha_lift(igcm_dust_mass)=1.e-6 !1.e-6 !Lifted mass coeff
+  
+          r0_lift = reff_lift/ref_r0
+          alpha_devil(igcm_dust_number)=r3n_q*
+***************
+*** 397,411 ****
+          alpha_lift(igcm_dust_number)=r3n_q*
+       &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+  
+! c       Not used:
+!         radius(igcm_dust_mass) = 0.
+!         radius(igcm_dust_number) = 0.
+  
+        else
+  
+         if (dustbin.gt.1) then
+!         print*,'ATTENTION:',
+!      $   ' properties of dust need input in initracer !!!'
+          stop
+  
+         else if (dustbin.eq.1) then
+--- 417,435 ----
+          alpha_lift(igcm_dust_number)=r3n_q*
+       &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+  
+!         radius(igcm_dust_mass) = reff_lift
+!         radius(igcm_dust_number) = reff_lift
+! 
+!         write(*,*) "initracer: doubleq_param reff_lift:", reff_lift
+!         write(*,*) "initracer: doubleq_param nueff_lift:", nueff_lift
+!         write(*,*) "initracer: doubleq_param alpha_lift:",
+!      &    alpha_lift(igcm_dust_mass)
+  
+        else
+  
+         if (dustbin.gt.1) then
+!         print*,'initracer: STOP!',
+!      $   ' properties of dust need to be set in initracer !!!'
+          stop
+  
+         else if (dustbin.eq.1) then
+***************
+*** 413,428 ****
+  c       This will be used for 1 dust particle size:
+  c       ------------------------------------------
+          radius(igcm_dustbin(1))=3.e-6
+-         Qext(igcm_dustbin(1))=3.04
+          alpha_lift(igcm_dustbin(1))=0.0e-6
+          alpha_devil(igcm_dustbin(1))=7.65e-9
+-         qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+-      &                         /(rho_dust*radius(igcm_dustbin(1)))
+          rho_q(igcm_dustbin(1))=rho_dust
+  
+         endif
+        end if    ! (doubleq)
+  
+  c     Initialization for photochemistry:
+  c     ---------------------------------
+        if (photochem) then
+--- 437,468 ----
+  c       This will be used for 1 dust particle size:
+  c       ------------------------------------------
+          radius(igcm_dustbin(1))=3.e-6
+          alpha_lift(igcm_dustbin(1))=0.0e-6
+          alpha_devil(igcm_dustbin(1))=7.65e-9
+          rho_q(igcm_dustbin(1))=rho_dust
+  
+         endif
+        end if    ! (doubleq)
+  
++ c     Submicron dust mode:
++ c     --------------------
++ 
++       if (submicron) then
++         radius(igcm_dust_submicron)=0.1e-6
++         rho_q(igcm_dust_submicron)=rho_dust
++         if (doubleq) then
++ c         If doubleq is also active, we use the population ratio:
++           alpha_lift(igcm_dust_submicron) = 
++      &      alpha_lift(igcm_dust_number)*popratio*
++      &      rho_q(igcm_dust_submicron)*4./3.*pi*
++      &      radius(igcm_dust_submicron)**3.
++           alpha_devil(igcm_dust_submicron)=1.e-30
++         else
++           alpha_lift(igcm_dust_submicron)=1e-6
++           alpha_devil(igcm_dust_submicron)=1.e-30
++         endif ! (doubleq)
++       end if  ! (submicron)
++ 
+  c     Initialization for photochemistry:
+  c     ---------------------------------
+        if (photochem) then
+***************
+*** 432,441 ****
+            txt=noms(iq)
+            if (txt(1:4).ne."dust") then
+              radius(iq)=0.
+-             Qext(iq)=0.
+              alpha_lift(iq) =0.
+              alpha_devil(iq)=0.
+-             qextrhor(iq)= 0.
+           endif
+          enddo ! do iq=1,nqmx
+        endif
+--- 472,479 ----
+***************
+*** 444,453 ****
+  c     ------------------------------
+        if(water) then
+           radius(igcm_h2o_vap)=0.
+-          Qext(igcm_h2o_vap)=0.
+           alpha_lift(igcm_h2o_vap) =0.
+           alpha_devil(igcm_h2o_vap)=0.
+-          qextrhor(igcm_h2o_vap)= 0.
+  
+  c       "Dryness coefficient" controlling the evaporation and
+  c        sublimation from the ground water ice (close to 1)
+--- 482,489 ----
+***************
+*** 484,494 ****
+           if(water.and.(nqmx.ge.2)) then
+             radius(igcm_h2o_ice)=3.e-6
+             rho_q(igcm_h2o_ice)=rho_ice
+-            Qext(igcm_h2o_ice)=0.
+             alpha_lift(igcm_h2o_ice) =0.
+             alpha_devil(igcm_h2o_ice)=0.
+-            qextrhor(igcm_h2o_ice)= (3./4.)*Qext(igcm_h2o_ice) 
+-      $       / (rho_ice*radius(igcm_h2o_ice))
+           elseif(water.and.(nqmx.lt.2)) then
+              write(*,*) 'nqmx is too low : nqmx=', nqmx
+              write(*,*) 'water= ',water
+--- 520,527 ----
+***************
+*** 508,514 ****
+          write(*,*) 'size distribution variance  = ', varian
+          write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+        end if
+!       write(*,*) 'Qext  = ', qext 
+!       write(*,*)
+  
+        end
+--- 541,682 ----
+          write(*,*) 'size distribution variance  = ', varian
+          write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+        end if
+! 
+! !
+! !     some extra (possibly redundant) sanity checks for tracers: 
+! !     ---------------------------------------------------------
+! 
+!        if (doubleq) then 
+!        ! verify that we indeed have dust_mass and dust_number tracers 
+!          if (igcm_dust_mass.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use doubleq option without ",
+!      &                "a dust_mass tracer !"
+!            stop
+!          endif
+!          if (igcm_dust_number.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use doubleq option without ",
+!      &                "a dust_number tracer !"
+!            stop
+!          endif
+!        endif
+! 
+!        if ((.not.doubleq).and.(dustbin.gt.0)) then
+!        ! verify that we indeed have 'dustbin' dust tracers
+!          count=0
+!          do iq=1,dustbin
+!            if (igcm_dustbin(iq).ne.0) then
+!              count=count+1
+!            endif
+!          enddo
+!          if (count.ne.dustbin) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  dusbin is set to ",dustbin,
+!      &                " but we only have the following dust tracers:"
+!            do iq=1,count
+!              write(*,*)"   ",trim(noms(igcm_dustbin(iq)))
+!            enddo
+!            stop
+!          endif
+!        endif
+! 
+!        if (water) then
+!        ! verify that we indeed have h2o_vap and h2o_ice tracers
+!          if (igcm_h2o_vap.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use water option without ",
+!      &                "an h2o_vap tracer !"
+!            stop
+!          endif
+!          if (igcm_h2o_ice.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use water option without ",
+!      &                "an h2o_ice tracer !"
+!            stop
+!          endif
+!        endif
+! 
+!        if (photochem .or. callthermos) then
+!        ! verify that we indeed have the chemistry tracers
+!          if (igcm_co2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a co2 tracer !"
+!          stop
+!          endif
+!          if (igcm_co.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a co tracer !"
+!          stop
+!          endif
+!          if (igcm_o.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a o tracer !"
+!          stop
+!          endif
+!          if (igcm_o1d.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a o1d tracer !"
+!          stop
+!          endif
+!          if (igcm_o2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "an o2 tracer !"
+!          stop
+!          endif
+!          if (igcm_o3.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "an o3 tracer !"
+!          stop
+!          endif
+!          if (igcm_h.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a h tracer !"
+!          stop
+!          endif
+!          if (igcm_h2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a h2 tracer !"
+!          stop
+!          endif
+!          if (igcm_oh.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "an oh tracer !"
+!          stop
+!          endif
+!          if (igcm_ho2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a ho2 tracer !"
+!          stop
+!          endif
+!          if (igcm_h2o2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a h2o2 tracer !"
+!          stop
+!          endif
+!          if (igcm_n2.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "a n2 tracer !"
+!          stop
+!          endif
+!          if (igcm_ar.eq.0) then
+!            write(*,*) "initracer: error !!"
+!            write(*,*) "  cannot use chemistry option without ",
+!      &                "an ar tracer !"
+!          stop
+!          endif
+!        endif ! of if (photochem .or. callthermos)
+  
+        end
+*** libf/phymars/iniwrite.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/iniwrite.F	Tue Feb 23 16:35:34 2010
+***************
+*** 55,64 ****
+        DO l=1,length
+           tab_cntrl(l)=0.
+        ENDDO
+!       tab_cntrl(1)  = FLOAT(iim)
+!       tab_cntrl(2)  = FLOAT(jjm)
+!       tab_cntrl(3)  = FLOAT(llm)
+!       tab_cntrl(4)  = FLOAT(idayref)
+        tab_cntrl(5)  = rad
+        tab_cntrl(6)  = omeg
+        tab_cntrl(7)  = g
+--- 55,64 ----
+        DO l=1,length
+           tab_cntrl(l)=0.
+        ENDDO
+!       tab_cntrl(1)  = real(iim)
+!       tab_cntrl(2)  = real(jjm)
+!       tab_cntrl(3)  = real(llm)
+!       tab_cntrl(4)  = real(idayref)
+        tab_cntrl(5)  = rad
+        tab_cntrl(6)  = omeg
+        tab_cntrl(7)  = g
+*** libf/phymars/lwu.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/lwu.F	Fri Nov 26 16:48:51 2010
+***************
+*** 24,29 ****
+--- 24,31 ----
+  c   water-ice crystals in each gridbox. Optical parameters of
+  c   water-ice clouds are convolved to crystal sizes predicted by
+  c   the microphysical scheme.
++ c
++ c MODIF : FF : removing the monster bug on water ice clouds 11/2010
+  c-----------------------------------------------------------------------
+   
+        implicit none
+***************
+*** 73,79 ****
+  
+        integer jl,jk,jkl,ja,n
+   
+!       real aer_u (ndlon,nir,nflev+1)     ! absorber amounts (aer) extinction
+        real co2c           ! co2 concentration (pa/pa)
+        real pview          ! cosecant of viewing angle
+        real pref           ! reference pressure (1013 mb = 101325 Pa)
+--- 75,81 ----
+  
+        integer jl,jk,jkl,ja,n
+   
+!       real aer_a (ndlon,nir,nflev+1) ! absorber amounts (aer) ABSORPTION
+        real co2c           ! co2 concentration (pa/pa)
+        real pview          ! cosecant of viewing angle
+        real pref           ! reference pressure (1013 mb = 101325 Pa)
+***************
+*** 140,146 ****
+        jk=nlaylte+1
+        do ja=1,nir
+          do jl = 1 , kdlon
+!           aer_u(jl,ja,jk)=0.
+          enddo
+        enddo
+  
+--- 142,148 ----
+        jk=nlaylte+1
+        do ja=1,nir
+          do jl = 1 , kdlon
+!           aer_a(jl,ja,jk)=0.
+          enddo
+        enddo
+  
+***************
+*** 148,154 ****
+          jkl=nlaylte+1-jk
+          do ja=1,nir
+            do jl=1,kdlon
+!              aer_u(jl,ja,jkl)=aer_u(jl,ja,jkl+1)+ tautotal(jl,jkl,ja)
+            enddo
+          enddo
+        enddo                 
+--- 150,157 ----
+          jkl=nlaylte+1-jk
+          do ja=1,nir
+            do jl=1,kdlon
+!              aer_a(jl,ja,jkl)=aer_a(jl,ja,jkl+1)+
+!      &           tautotal(jl,jkl,ja)*(1.-omegtotal(jl,jkl,ja))
+            enddo
+          enddo
+        enddo                 
+***************
+*** 197,204 ****
+  c   on multiplie le Qext  par 1-omega dans la bande du CO2.
+  c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr
+  
+!            zzz=pview*(1.-omegtotal(jl,jkl,ja))
+!            aer_t(jl,ja,jkl)=exp(-zzz*aer_u(jl,ja,jkl))
+            
+            enddo
+          enddo
+--- 200,206 ----
+  c   on multiplie le Qext  par 1-omega dans la bande du CO2.
+  c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr
+  
+!            aer_t(jl,ja,jkl)=exp(-pview*aer_a(jl,ja,jkl))
+            
+            enddo
+          enddo
+*** libf/phymars/newsedim.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/newsedim.F	Tue Jan 25 11:23:56 2011
+***************
+*** 1,5 ****
+        SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+!      &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq)
+        IMPLICIT NONE
+  
+  c=======================================================================
+--- 1,5 ----
+        SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+!      &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq,beta)
+        IMPLICIT NONE
+  
+  c=======================================================================
+***************
+*** 20,38 ****
+  c   arguments:
+  c   ----------
+  
+!       INTEGER ngrid,nlay,naersize
+!       REAL ptimestep            ! pas de temps physique (s)
+!       REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+!       REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+!       real masse (ngrid,nlay) ! masse d'une couche (kg)
+!       real epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+!       real rd(naersize)             ! particle radius (m)
+!       real rho             ! particle density (kg.m-3)
+  
+  
+  c    Traceurs :
+!       real pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+!       real wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+        
+  c   local:
+  c   ------
+--- 20,43 ----
+  c   arguments:
+  c   ----------
+  
+!       INTEGER,INTENT(IN) :: ngrid,nlay,naersize
+!       REAL,INTENT(IN) :: ptimestep            ! pas de temps physique (s)
+!       REAL,INTENT(IN) :: pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa)
+!       REAL,INTENT(IN) :: pt(ngrid,nlay) ! temperature au centre des couches (K)
+!       real,intent(in) :: masse (ngrid,nlay) ! masse d'une couche (kg)
+!       real,intent(in) :: epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+!       real,intent(in) :: rd(naersize)             ! particle radius (m)
+!       real,intent(in) :: rho             ! particle density (kg.m-3)
+  
+  
+  c    Traceurs :
+!       real,intent(inout) :: pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+!       real,intent(out) :: wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+!       real,intent(in) :: beta ! correction for the shape of the particles
+!                 !   (see Murphy et al. JGR 1990 vol.95)
+!                 !   beta=1 for spheres
+!                 !   beta=0.85 for irregular particles
+!                 !   beta=0.5 for disk shaped particles
+        
+  c   local:
+  c   ------
+***************
+*** 40,47 ****
+        INTEGER l,ig, k, i
+        REAL rfall
+  
+!       LOGICAL firstcall
+!       SAVE firstcall
+  
+  c    Traceurs :
+  c    ~~~~~~~~ 
+--- 45,51 ----
+        INTEGER l,ig, k, i
+        REAL rfall
+  
+!       LOGICAL,SAVE :: firstcall=.true.
+  
+  c    Traceurs :
+  c    ~~~~~~~~ 
+***************
+*** 50,68 ****
+        real w(ngridmx,nlayermx)
+        real ptop, dztop, Ep, Stra
+  
+-       DATA firstcall/.true./
+  
+  c    Physical constant
+  c    ~~~~~~~~~~~~~~~~~
+-       REAL visc, molrad
+  c     Gas molecular viscosity (N.s.m-2)
+!       data visc/1.e-5/       ! CO2
+  c     Effective gas molecular radius (m)
+!       data molrad/2.2e-10/   ! CO2
+  
+  c     local and saved variable
+!       real a,b
+!       save a,b
+  
+  
+  
+--- 54,69 ----
+        real w(ngridmx,nlayermx)
+        real ptop, dztop, Ep, Stra
+  
+  
+  c    Physical constant
+  c    ~~~~~~~~~~~~~~~~~
+  c     Gas molecular viscosity (N.s.m-2)
+!       real,parameter :: visc=1.e-5       ! CO2
+  c     Effective gas molecular radius (m)
+!       real,parameter :: molrad=2.2e-10   ! CO2
+  
+  c     local and saved variable
+!       real,save :: a,b
+  
+  
+  
+***************
+*** 86,102 ****
+  c       - Constant to compute stokes speed simple formulae
+  c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+           b = 2./9. * g / visc
+  
+  c       - Constant  to compute gas mean free path
+  c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+           a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+  
+  c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+! c   (correction = 0.85 for irregular particles, 0.5 for disk shaped particles)
+! c        a = a    * 0.85
+!       ENDIF
+! 
+! 
+  
+  
+  
+--- 87,100 ----
+  c       - Constant to compute stokes speed simple formulae
+  c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+           b = 2./9. * g / visc
++       ENDIF ! of IF(firstcall)
+        
+  c       - Constant  to compute gas mean free path
+  c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+           a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+  
+  c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+!          a = a * beta
+  
+  
+  
+*** libf/phymars/phyetat0.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/phyetat0.F	Fri Sep  3 09:18:38 2010
+***************
+*** 1,13 ****
+        SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,nq,
+       .           day_ini,time,
+       .           tsurf,tsoil,emis,q2,qsurf,co2ice)
+        implicit none
+  c======================================================================
+  c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+  c  Adaptation à Mars : Yann Wanherdrick 
+  c Objet: Lecture de l etat initial pour la physique
+  c======================================================================
+! #include "netcdf.inc"
+  #include "dimensions.h"
+  #include "dimphys.h"
+  #include "comgeomfi.h"
+--- 1,19 ----
+        SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,nq,
+       .           day_ini,time,
+       .           tsurf,tsoil,emis,q2,qsurf,co2ice)
++ 
++       use netcdf
++ 
+        implicit none
+  c======================================================================
+  c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+  c  Adaptation à Mars : Yann Wanherdrick 
+  c Objet: Lecture de l etat initial pour la physique
++ ! Modifs: Aug.2010 EM : use NetCDF90 to load variables (enables using
++ !                      r4 or r8 restarts independently of having compiled
++ !                      the GCM in r4 or r8)
+  c======================================================================
+! !#include "netcdf.inc"
+  #include "dimensions.h"
+  #include "dimphys.h"
+  #include "comgeomfi.h"
+***************
+*** 34,41 ****
+        real time
+  
+  !  outputs:
+!       real tsurf(ngridmx,nbsrf) ! surface temperature
+!       real tsoil(ngridmx,nsoil,nbsrf) ! soil temperature
+        real emis(ngridmx) ! surface emissivity
+        real q2(ngridmx, llm+1) ! 
+        real qsurf(ngridmx,nq) ! tracers on surface
+--- 40,47 ----
+        real time
+  
+  !  outputs:
+!       real tsurf(ngridmx) ! surface temperature
+!       real tsoil(ngridmx,nsoil) ! soil temperature
+        real emis(ngridmx) ! surface emissivity
+        real q2(ngridmx, llm+1) ! 
+        real qsurf(ngridmx,nq) ! tracers on surface
+***************
+*** 44,53 ****
+  !======================================================================
+  !  Local variables:
+  
+! !      INTEGER radpas
+! !      REAL co2_ppm
+! !      REAL solaire
+! 
+        real xmin,xmax ! to display min and max of a field
+  c
+        INTEGER ig,iq,lmax
+--- 50,56 ----
+  !======================================================================
+  !  Local variables:
+  
+!       real surffield(ngridmx) ! to temporarily store a surface field
+        real xmin,xmax ! to display min and max of a field
+  c
+        INTEGER ig,iq,lmax
+***************
+*** 73,81 ****
+  c Ouvrir le fichier contenant l etat initial:
+  c
+  
+!       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+!       IF (ierr.NE.NF_NOERR) THEN
+!         write(6,*)' Pb d''ouverture du fichier '//fichnom
+          CALL ABORT
+        ENDIF
+  
+--- 76,85 ----
+  c Ouvrir le fichier contenant l etat initial:
+  c
+  
+!       ierr=nf90_open(fichnom,NF90_NOWRITE,nid)
+!       IF (ierr.NE.nf90_noerr) THEN
+!         write(6,*)' Pb d''ouverture du fichier ',trim(fichnom)
+!         write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+  
+***************
+*** 85,92 ****
+        do iq=1,nqmx
+          txt= " "
+          write(txt,'(a5,i2.2)')'qsurf',iq
+!         ierr=NF_INQ_VARID(nid,txt,nvarid)
+!         if (ierr.ne.NF_NOERR) then
+            ! did not find old tracer name
+            exit ! might as well stop here
+          else
+--- 89,96 ----
+        do iq=1,nqmx
+          txt= " "
+          write(txt,'(a5,i2.2)')'qsurf',iq
+!         ierr=nf90_inq_varid(nid,txt,nvarid)
+!         if (ierr.ne.nf90_noerr) then
+            ! did not find old tracer name
+            exit ! might as well stop here
+          else
+***************
+*** 110,161 ****
+  c
+  c Lecture des latitudes (coordonnees):
+  c
+!       ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <latitude> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lati)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, lati)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+           CALL abort
+        ENDIF
+  c
+  c Lecture des longitudes (coordonnees):
+  c
+!       ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <longitude> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, long)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, long)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
+           CALL abort
+        ENDIF
+  c
+  c Lecture des aires des mailles:
+  c
+!       ierr = NF_INQ_VARID (nid, "area", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <area> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, area)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, area)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <area>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 114,159 ----
+  c
+  c Lecture des latitudes (coordonnees):
+  c
+!       ierr=nf90_inq_varid(nid,"latitude",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <latitude> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,lati)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+  c
+  c Lecture des longitudes (coordonnees):
+  c
+!       ierr=nf90_inq_varid(nid,"longitude",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <longitude> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,long)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+  c
+  c Lecture des aires des mailles:
+  c
+!       ierr=nf90_inq_varid(nid,"area",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <area> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,area)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <area>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 166,183 ****
+  c
+  c Lecture du geopotentiel au sol:
+  c
+!       ierr = NF_INQ_VARID (nid, "phisfi", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <phisfi> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisfi)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, phisfi)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 164,179 ----
+  c
+  c Lecture du geopotentiel au sol:
+  c
+!       ierr=nf90_inq_varid(nid,"phisfi",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <phisfi> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,phisfi)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 188,204 ****
+  c
+  c Lecture de l''albedo du sol nu:
+  c
+!       ierr = NF_INQ_VARID (nid, "albedodat", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <albedodat> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albedodat)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, albedodat)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
+           CALL abort
+        ENDIF
+--- 184,197 ----
+  c
+  c Lecture de l''albedo du sol nu:
+  c
+!       ierr=nf90_inq_varid(nid,"albedodat",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <albedodat> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,albedodat)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
+           CALL abort
+        ENDIF
+***************
+*** 211,217 ****
+  c Lecture de l''inertie thermique du sol:
+  c
+  !      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+! !      IF (ierr.NE.NF_NOERR) THEN
+  !         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+  !         CALL abort
+  !      ENDIF
+--- 204,210 ----
+  c Lecture de l''inertie thermique du sol:
+  c
+  !      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+! !      IF (ierr.NE.nf90_noerr) THEN
+  !         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+  !         CALL abort
+  !      ENDIF
+***************
+*** 220,226 ****
+  !#else
+  !      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+  !#endif
+! !      IF (ierr.NE.NF_NOERR) THEN
+  !         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+  !         CALL abort
+  !      ENDIF
+--- 213,219 ----
+  !#else
+  !      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+  !#endif
+! !      IF (ierr.NE.nf90_noerr) THEN
+  !         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+  !         CALL abort
+  !      ENDIF
+***************
+*** 232,249 ****
+  c
+  c ZMEA
+  c
+!       ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 225,240 ----
+  c
+  c ZMEA
+  c
+!       ierr=nf90_inq_varid(nid,"ZMEA",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,zmea)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 256,273 ****
+  c
+  c ZSTD
+  c
+!       ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 247,262 ----
+  c
+  c ZSTD
+  c
+!       ierr=nf90_inq_varid(nid,"ZSTD",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,zstd)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 280,297 ****
+  c
+  c ZSIG
+  c
+!       ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 269,284 ----
+  c
+  c ZSIG
+  c
+!       ierr=nf90_inq_varid(nid,"ZSIG",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,zsig)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 304,321 ****
+  c
+  c ZGAM
+  c
+!       ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 291,306 ----
+  c
+  c ZGAM
+  c
+!       ierr=nf90_inq_varid(nid,"ZGAM",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,zgam)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 328,345 ****
+  c
+  c ZTHE
+  c
+!       ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 313,328 ----
+  c
+  c ZTHE
+  c
+!       ierr=nf90_inq_varid(nid,"ZTHE",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,zthe)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 352,369 ****
+  c
+  c CO2 ice cover
+  c
+!       ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <co2ice> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, co2ice)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, co2ice)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 335,350 ----
+  c
+  c CO2 ice cover
+  c
+!       ierr=nf90_inq_varid(nid,"co2ice",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <co2ice> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,co2ice)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 374,419 ****
+  c
+  c Lecture des temperatures du sol:
+  c
+!       ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <tsurf> est absent'
+!          PRINT*, '          Mais je vais essayer de lire TS**'
+!          IF (nbsrf.GT.99) THEN
+!             PRINT*, "Trop de sous-mailles"
+!             CALL abort
+!          ENDIF
+!          DO nsrf = 1, nbsrf
+!            WRITE(str2,'(i2.2)') nsrf
+!            ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
+!            IF (ierr.NE.NF_NOERR) THEN
+!               PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
+!               CALL abort
+!            ENDIF
+! #ifdef NC_DOUBLE
+!            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,nsrf))
+! #else
+!            ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,nsrf))
+! #endif
+!            IF (ierr.NE.NF_NOERR) THEN
+!              PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
+!              CALL abort
+!            ENDIF
+!            xmin = 1.0E+20
+!            xmax = -1.0E+20
+!            xmin = MINVAL(tsurf)
+!            xmax = MAXVAL(tsurf)
+!            PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
+!          ENDDO
+        ELSE
+           PRINT*, 'phyetat0: Le champ <tsurf> est present'
+           PRINT*, '          J ignore donc les autres temperatures TS**'
+! #ifdef NC_DOUBLE
+!          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,1))
+! #else
+!          ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,1))
+! #endif
+!          IF (ierr.NE.NF_NOERR) THEN
+              PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
+              CALL abort
+           ENDIF
+           xmin = 1.0E+20
+--- 355,397 ----
+  c
+  c Lecture des temperatures du sol:
+  c
+!       ierr=nf90_inq_varid(nid,"tsurf",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <tsurf> est absent'
+! ! Ehouarn: dump this part (causes problems with netcdf90 interface)
+! !         PRINT*, '          Mais je vais essayer de lire TS**'
+! !         IF (nbsrf.GT.99) THEN
+! !            PRINT*, "Trop de sous-mailles"
+! !            CALL abort
+! !         ENDIF
+! !         DO nsrf = 1, nbsrf
+! !           WRITE(str2,'(i2.2)') nsrf
+! !           ierr=nf90_inq_varid(nid,"TS"//str2,nvarid)
+! !           IF (ierr.NE.nf90_noerr) THEN
+! !              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
+! !              write(*,*)trim(nf90_strerror(ierr))
+! !              CALL abort
+! !           ENDIF
+! !           ierr=nf90_get_var(nid,nvarid,tsurf(1,nsrf))
+! !           IF (ierr.NE.nf90_noerr) THEN
+! !             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
+! !             write(*,*)trim(nf90_strerror(ierr))
+! !             CALL abort
+! !           ENDIF
+! !           xmin = 1.0E+20
+! !           xmax = -1.0E+20
+! !           xmin = MINVAL(tsurf)
+! !           xmax = MAXVAL(tsurf)
+! !           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
+! !         ENDDO
+        ELSE
+           PRINT*, 'phyetat0: Le champ <tsurf> est present'
+           PRINT*, '          J ignore donc les autres temperatures TS**'
+!          !ierr=nf90_get_var(nid,nvarid,tsurf(1,1))
+!          ierr=nf90_get_var(nid,nvarid,tsurf)
+!          IF (ierr.NE.nf90_noerr) THEN
+              PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
++             write(*,*)trim(nf90_strerror(ierr))
+              CALL abort
+           ENDIF
+           xmin = 1.0E+20
+***************
+*** 421,433 ****
+           xmin = MINVAL(tsurf)
+           xmax = MAXVAL(tsurf)
+           PRINT*,'Temperature du sol <tsurf>', xmin, xmax
+!          IF (nbsrf >= 2) THEN
+!             DO nsrf = 2, nbsrf
+!                DO i = 1, ngridmx
+!                   tsurf(i,nsrf) = tsurf(i,1)
+!                ENDDO
+!             ENDDO
+!          ENDIF
+        ENDIF
+  c
+  c Lecture des temperatures du sol profond:
+--- 399,412 ----
+           xmin = MINVAL(tsurf)
+           xmax = MAXVAL(tsurf)
+           PRINT*,'Temperature du sol <tsurf>', xmin, xmax
+! ! Ehouarn: Mars => nbsurf=1
+! !         IF (nbsrf >= 2) THEN
+! !            DO nsrf = 2, nbsrf
+! !               DO i = 1, ngridmx
+! !                  tsurf(i,nsrf) = tsurf(i,1)
+! !               ENDDO
+! !            ENDDO
+! !         ENDIF
+        ENDIF
+  c
+  c Lecture des temperatures du sol profond:
+***************
+*** 440,446 ****
+  !         DO isoil=1, nsoil
+  !            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+  !            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+! !            IF (ierr.NE.NF_NOERR) THEN
+  !               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+  !               PRINT*, "          Il prend donc la valeur de surface"
+  !               DO i=1, ngridmx
+--- 419,425 ----
+  !         DO isoil=1, nsoil
+  !            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+  !            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+! !            IF (ierr.NE.nf90_noerr) THEN
+  !               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+  !               PRINT*, "          Il prend donc la valeur de surface"
+  !               DO i=1, ngridmx
+***************
+*** 452,458 ****
+  !#else
+  !              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+  !#endif
+! !               IF (ierr.NE.NF_NOERR) THEN
+  !                  PRINT*, "Lecture echouee pour <tsoil>"
+  !                  CALL abort
+  !               ENDIF
+--- 431,437 ----
+  !#else
+  !              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+  !#endif
+! !               IF (ierr.NE.nf90_noerr) THEN
+  !                  PRINT*, "Lecture echouee pour <tsoil>"
+  !                  CALL abort
+  !               ENDIF
+***************
+*** 467,484 ****
+  c
+  c Surface emissivity
+  c
+!       ierr = NF_INQ_VARID (nid, "emis", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <emis> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, emis)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, emis)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <emis>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 446,461 ----
+  c
+  c Surface emissivity
+  c
+!       ierr=nf90_inq_varid(nid,"emis",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <emis> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,emis)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <emis>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 489,506 ****
+  c
+  c pbl wind variance
+  c
+!       ierr = NF_INQ_VARID (nid, "q2", nvarid)
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Le champ <q2> est absent'
+           CALL abort
+        ENDIF
+! #ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q2)
+! #else
+!       ierr = NF_GET_VAR_REAL(nid, nvarid, q2)
+! #endif
+!       IF (ierr.NE.NF_NOERR) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <q2>'
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+--- 466,481 ----
+  c
+  c pbl wind variance
+  c
+!       ierr=nf90_inq_varid(nid,"q2",nvarid)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Le champ <q2> est absent'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+!       ierr=nf90_get_var(nid,nvarid,q2)
+!       IF (ierr.NE.nf90_noerr) THEN
+           PRINT*, 'phyetat0: Lecture echouee pour <q2>'
++          write(*,*)trim(nf90_strerror(ierr))
+           CALL abort
+        ENDIF
+        xmin = 1.0E+20
+***************
+*** 531,538 ****
+       &                     ' h2o_ice instead of h2o_vap'
+               endif
+             ENDIF ! of IF (oldtracernames) THEN
+!            ierr=NF_INQ_VARID(nid,txt,nvarid)
+!            IF (ierr.NE.NF_NOERR) THEN
+               write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
+       &                  ' not found in file'
+               write(*,*) trim(txt), ' set to 0'
+--- 506,513 ----
+       &                     ' h2o_ice instead of h2o_vap'
+               endif
+             ENDIF ! of IF (oldtracernames) THEN
+!            ierr=nf90_inq_varid(nid,txt,nvarid)
+!            IF (ierr.NE.nf90_noerr) THEN
+               write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
+       &                  ' not found in file'
+               write(*,*) trim(txt), ' set to 0'
+***************
+*** 541,553 ****
+               end do
+               nqold=min(iq-1,nqold)
+             ELSE
+! #ifdef NC_DOUBLE
+!              ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+! #else
+!              ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+! #endif
+!              IF (ierr.NE.NF_NOERR) THEN
+                 PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
+                 CALL abort
+               ENDIF
+             ENDIF
+--- 516,527 ----
+               end do
+               nqold=min(iq-1,nqold)
+             ELSE
+!            !ierr=nf90_get_var(nid,nvarid,qsurf(1,iq))
+!            ierr=nf90_get_var(nid,nvarid,surffield)
+!            qsurf(1:ngridmx,iq)=surffield(1:ngridmx)
+!              IF (ierr.NE.nf90_noerr) THEN
+                 PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
++                write(*,*)trim(nf90_strerror(ierr))
+                 CALL abort
+               ENDIF
+             ENDIF
+***************
+*** 561,583 ****
+  c        case when new tracer are added in addition to old ones
+               write(*,*)'qsurf 1 to ', nqold,'were already present'
+               write(*,*)'qsurf ', nqold+1,' to ', nqmx,'are new'
+!             yes=' '
+!             do while ((yes.ne.'y').and.(yes.ne.'n'))
+!              write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
+!              write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+!              read(*,fmt='(a)') yes
+!             end do
+!             if (yes.eq.'y') then
+!               write(*,*) 'OK, let s reindex qsurf'
+!                  do ig=1,ngridmx
+!                     do iq=nqmx,nqmx-nqold+1,-1
+!                        qsurf(ig,iq)=qsurf(ig,iq-nqmx+nqold)
+!                     end do
+!                     do iq=nqmx-nqold,1,-1
+!                        qsurf(ig,iq)= 0.
+!                     end do
+!                  end do
+!             end if
+           end if
+        ENDIF
+  
+--- 535,557 ----
+  c        case when new tracer are added in addition to old ones
+               write(*,*)'qsurf 1 to ', nqold,'were already present'
+               write(*,*)'qsurf ', nqold+1,' to ', nqmx,'are new'
+! !            yes=' '
+! !            do while ((yes.ne.'y').and.(yes.ne.'n'))
+! !             write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
+! !             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+! !             read(*,fmt='(a)') yes
+! !            end do
+! !            if (yes.eq.'y') then
+! !              write(*,*) 'OK, let s reindex qsurf'
+! !                 do ig=1,ngridmx
+! !                    do iq=nqmx,nqmx-nqold+1,-1
+! !                       qsurf(ig,iq)=qsurf(ig,iq-nqmx+nqold)
+! !                    end do
+! !                    do iq=nqmx-nqold,1,-1
+! !                       qsurf(ig,iq)= 0.
+! !                    end do
+! !                 end do
+! !            end if
+           end if
+        ENDIF
+  
+***************
+*** 588,594 ****
+  c
+  c Fermer le fichier:
+  c
+!       ierr = NF_CLOSE(nid)
+  c
+        RETURN
+        END
+--- 562,568 ----
+  c
+  c Fermer le fichier:
+  c
+!       ierr=nf90_close(nid)
+  c
+        RETURN
+        END
+*** libf/phymars/readtesassim.F90	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/readtesassim.F90	Fri Sep  3 09:29:15 2010
+***************
+*** 2,13 ****
+  
+  ! 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"
+  
+--- 2,13 ----
+  
+  ! Reading of the dust assimilation file
+  
++ use netcdf
+  implicit none
+  
+  #include "dimensions.h"
+  #include "dimphys.h"
+  #include "comgeomfi.h"
+  #include "datafile.h"
+  #include "callkeys.h"
+  
+***************
+*** 59,71 ****
+       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 '
+--- 59,70 ----
+       filename="dust_tes_MY25.nc" 
+     else if (iaervar.eq.26) then
+       filename="dust_tes_MY26.nc"
+     endif
+     
+     ! Note: datafile() is defined in "datafile.h"
+!    !ierr=NF_OPEN(trim(datafile)//"/"//trim(filename),NF_NOWRITE,nid)
+!    ierr=nf90_open(trim(datafile)//"/"//trim(filename),NF90_NOWRITE,nid)
+!    IF (ierr.NE.nf90_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 '
+***************
+*** 76,134 ****
+       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
+--- 75,125 ----
+       CALL ABORT
+     ENDIF
+  
+!    ierr=nf90_inq_dimid(nid,"Time",timedim)
+!    ierr=nf90_inquire_dimension(nid,timedim,len=timelen)
+!    ierr=nf90_inq_dimid(nid,"latitude",latdim)
+!    ierr=nf90_inquire_dimension(nid,latdim,len=latlen)
+!    ierr=nf90_inq_dimid(nid,"longitude",londim)
+!    ierr=nf90_inquire_dimension(nid,londim,len=lonlen)
+! 
+  
+     allocate(tautes(lonlen,latlen,timelen))
+     allocate(lat(latlen), lon(lonlen), time(timelen))
+  
+!    ierr=nf90_inq_varid(nid,"dustop",nvarid)
+!    ierr=nf90_get_var(nid,nvarid,tautes)
+!    IF (ierr .NE. nf90_noerr) THEN
+        PRINT*, "Error: Readtesassim <dustop> not found"
++       write(*,*)trim(nf90_strerror(ierr))
+        stop
+     ENDIF
+! 
+!    ierr=nf90_inq_varid(nid,"Time",nvarid)
+!    ierr=nf90_get_var(nid,nvarid,time)
+!    IF (ierr .NE. nf90_noerr) THEN
+        PRINT*, "Error: Readtesassim <Time> not found"
++       write(*,*)trim(nf90_strerror(ierr))
+        stop
+     ENDIF
+  
+!    ierr=nf90_inq_varid(nid,"latitude",nvarid)
+!    ierr=nf90_get_var(nid,nvarid,lat)
+!    IF (ierr .NE. nf90_noerr) THEN
+        PRINT*, "Error: Readtesassim <latitude> not found"
++       write(*,*)trim(nf90_strerror(ierr))
+        stop
+     ENDIF
+  
+!    ierr=nf90_inq_varid(nid,"longitude",nvarid)
+!    ierr=nf90_get_var(nid,nvarid,lon)
+!    IF (ierr .NE. nf90_noerr) THEN
+        PRINT*, "Error: Readtesassim <longitude> not found"
++       write(*,*)trim(nf90_strerror(ierr))
+        stop
+     ENDIF
+  
++    ierr=nf90_close(nid)
++ 
+  endif ! of if (firstcall)
+  
+  do ig=1,ngrid
+***************
+*** 141,146 ****
+--- 132,150 ----
+     londeg=long(ig)*radeg  ! longitude, in degrees east
+     colat=90-latdeg        ! colatitude, in degrees
+  
++ ! Ehouarn: rounding effects and/or specific compiler issues
++ !          sometime cause londeg to be sligthly below -180 ...
++   if (londeg.lt.-180) then
++     ! check if it is by a large amount
++     if ((londeg+180).lt.-1.e-3) then
++       write(*,*) 'reattesassim: error!!'
++       write(*,*) ' ig=',ig,' londeg=',londeg
++       stop
++     else
++       londeg=-180
++     endif
++   endif
++ 
+   ! Find encompassing latitudes
+     if (colat<(90-lat(1))) then ! between north pole and lat(1)
+        ysup=1
+***************
+*** 283,292 ****
+     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
+--- 287,292 ----
+*** libf/phymars/surfdat.h	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/surfdat.h	Mon Feb  1 10:57:51 2010
+***************
+*** 8,15 ****
+        COMMON/surfdatl/TESicealbedo
+  
+        real albedodat ! albedo of bare ground
+- ! Ehouarn: moved inertiedat to comsoil.h
+- !      real inertiedat, ! thermal inertia
+        real phisfi ! geopotential at ground level
+        real albedice ! default albedo for ice (1: North H. 2: South H.)
+        real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+--- 8,13 ----
+*** libf/phymars/tabfi.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/tabfi.F	Tue Feb 23 16:34:38 2010
+***************
+*** 226,234 ****
+        write(*,*) '*****************************************************'
+        write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+        write(*,*) '*****************************************************'
+!       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+!       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+!       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+        write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+        write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+        write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+--- 226,234 ----
+        write(*,*) '*****************************************************'
+        write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+        write(*,*) '*****************************************************'
+!       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+!       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+!       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+        write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+        write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+        write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+***************
+*** 475,483 ****
+        write(*,*) '*****************************************************'
+        write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+        write(*,*) '*****************************************************'
+!       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+!       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+!       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+        write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+        write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+        write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+--- 475,483 ----
+        write(*,*) '*****************************************************'
+        write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+        write(*,*) '*****************************************************'
+!       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+!       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+!       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+        write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+        write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+        write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+*** libf/phymars/tracer.h	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/tracer.h	Mon Nov 22 17:30:13 2010
+***************
+*** 5,19 ****
+        real mmol(nqmx)           ! mole mass of tracer (g/mol-1) 
+        real radius(nqmx)   ! dust and ice particle radius (m)
+        real rho_q(nqmx)    ! tracer densities (kg.m-3)
+-       real qext(nqmx)     ! Single Scat. Extinction coeff at 0.67 um
+        real alpha_lift(nqmx) ! saltation vertical flux/horiz flux ratio (m-1)
+        real alpha_devil(nqmx) ! lifting coeeficient by dust devil
+  
+        real varian      ! Characteristic variance of log-normal distribution
+        real r3n_q     ! used to compute r0 from number and mass mixing ratio
+-       real qextrhor(nqmx) ! Intermediate for computing opt. depth from q
+        real rho_dust     ! Mars dust density (kg.m-3)
+        real rho_ice     ! Water ice density (kg.m-3)
+        real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+  
+        real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
+--- 5,18 ----
+        real mmol(nqmx)           ! mole mass of tracer (g/mol-1) 
+        real radius(nqmx)   ! dust and ice particle radius (m)
+        real rho_q(nqmx)    ! tracer densities (kg.m-3)
+        real alpha_lift(nqmx) ! saltation vertical flux/horiz flux ratio (m-1)
+        real alpha_devil(nqmx) ! lifting coeeficient by dust devil
+  
+        real varian      ! Characteristic variance of log-normal distribution
+        real r3n_q     ! used to compute r0 from number and mass mixing ratio
+        real rho_dust     ! Mars dust density (kg.m-3)
+        real rho_ice     ! Water ice density (kg.m-3)
++       real nuice_ref   ! Effective variance of the water ice dist.
+        real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+  
+        real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
+***************
+*** 23,30 ****
+        ! dust
+        integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+        ! dust, special doubleq case
+!       integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+!       integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+        ! water
+        integer :: igcm_h2o_vap ! water vapour
+        integer :: igcm_h2o_ice ! water ice
+--- 22,33 ----
+        ! dust
+        integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+        ! dust, special doubleq case
+!       integer :: igcm_dust_mass   ! dust mass mixing ratio
+!                                   !   (for transported dust)
+!       integer :: igcm_dust_number ! dust number mixing ratio
+!                                   !   (transported dust)
+!       integer :: igcm_dust_submicron ! submicron dust mixing ratio
+!                                      !   (transported dust)
+        ! water
+        integer :: igcm_h2o_vap ! water vapour
+        integer :: igcm_h2o_ice ! water ice
+***************
+*** 49,58 ****
+  
+  ! NB: to keep commons aligned: 
+  !     split them in groups (reals, integers and characters)
+!       COMMON/tracer/radius,rho_q,qext,alpha_lift,alpha_devil,mmol,      &
+!      & varian,r3n_q,qextrhor,rho_dust,rho_ice,ref_r0,dryness
+!       COMMON/tracer2/
+!      & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &
+       & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+       & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+       & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+--- 52,61 ----
+  
+  ! NB: to keep commons aligned: 
+  !     split them in groups (reals, integers and characters)
+!       COMMON/tracer/radius,rho_q,alpha_lift,alpha_devil,mmol,           &
+!      & varian,r3n_q,rho_dust,rho_ice,nuice_ref,ref_r0,dryness
+!       COMMON/tracer2/                                                   &
+!      & igcm_dustbin,igcm_dust_mass,igcm_dust_number,igcm_dust_submicron,&
+       & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+       & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+       & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+*** libf/phymars/updatereffrad.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/updatereffrad.F	Mon Nov 22 18:48:23 2010
+***************
+*** 1,7 ****
+        SUBROUTINE updatereffrad(ngrid,nlayer,
+!      &                pplev,pplay,
+!      &                rice,nuice,
+!      &                reffrad,nueffrad)
+  
+         IMPLICIT NONE
+  c=======================================================================
+--- 1,7 ----
+        SUBROUTINE updatereffrad(ngrid,nlayer,
+!      &                rdust,rice,nuice,
+!      &                reffrad,nueffrad,
+!      &                pq)
+  
+         IMPLICIT NONE
+  c=======================================================================
+***************
+*** 13,26 ****
+  c     variance "nueffrad".
+  c   At firstcall, "rice" and "nuice" are not known, because
+  c     the H2O ice microphysical scheme is called after the radiative
+! c     transfer in physiq.F. That's why we call watercloud at firstcall
+! c     in physiq.F before calling updatereffrad. Of course, resulting
+! c     tendencies are not used to compute the water cycle.
+! c   See callradite.F for more information.
+  c
+  c   author:   
+  c   ------
+! c   J.-B. Madeleine (2009)
+  c
+  c=======================================================================
+  c
+--- 13,24 ----
+  c     variance "nueffrad".
+  c   At firstcall, "rice" and "nuice" are not known, because
+  c     the H2O ice microphysical scheme is called after the radiative
+! c     transfer in physiq.F. That's why we assess the size of the 
+! c     water-ice particles at firstcall (see part 1.2 below).
+  c
+  c   author:   
+  c   ------
+! c   J.-B. Madeleine (2009-2010)
+  c
+  c=======================================================================
+  c
+***************
+*** 29,51 ****
+  c
+  #include "dimensions.h"
+  #include "dimphys.h"
+  #include "callkeys.h"
+  #include "dimradmars.h"
+  #include "tracer.h"
+  
+  c-----------------------------------------------------------------------
+  c     Inputs:
+  c     ------
+  
+!       INTEGER :: ngrid,nlayer
+! c     Pressure between each layer (Pa)
+!       REAL pplev(ngrid,nlayer+1)
+! c     Pressure in the middle of each layer (Pa)
+!       REAL pplay(ngrid,nlayer)
+! c     Estimated ice crystal radius (m)
+        REAL :: rice(ngridmx,nlayermx)
+  c     Estimated effective variance of the size distribution (n.u.)
+        REAL :: nuice(ngridmx,nlayermx)
+  
+  c     Outputs:
+  c     -------
+--- 27,53 ----
+  c
+  #include "dimensions.h"
+  #include "dimphys.h"
++ #include "comcstfi.h"
+  #include "callkeys.h"
+  #include "dimradmars.h"
+  #include "tracer.h"
++ #include "aerkind.h"
++ #include "yomaer.h"
+  
+  c-----------------------------------------------------------------------
+  c     Inputs:
+  c     ------
+  
+!       INTEGER ngrid,nlayer
+! c     Ice geometric mean radius (m)
+        REAL :: rice(ngridmx,nlayermx)
+  c     Estimated effective variance of the size distribution (n.u.)
+        REAL :: nuice(ngridmx,nlayermx)
++ c     Tracer mass mixing ratio (kg/kg)
++       REAL pq(ngrid,nlayer,nqmx)
++       real rdust(ngridmx,nlayermx) ! Dust geometric mean radius (m)
++       real reffdust(ngridmx,nlayermx) ! Dust effective radius (m)
++       real nueffdust(ngridmx,nlayermx) ! Dust effective variance
+  
+  c     Outputs:
+  c     -------
+***************
+*** 61,116 ****
+        INTEGER :: ig,l                          ! 3D grid indices
+        INTEGER :: iaer                          ! Aerosol index
+  
+! c     Hyperbolic tangent function coefficients used to describe
+! c       dust size vertical profile (reff=f(pplay))
+!       REAL, PARAMETER :: dustcoefa = 0.10003736
+!       REAL, PARAMETER :: dustcoefb = 0.77463902
+!       REAL, PARAMETER :: dustcoefc = 3.1483479
+!       REAL, PARAMETER :: dustcoefd = 2.4331281
+  
+  c     Local saved variables:
+  c     ---------------------
+  
+  c==================================================================
+! 
+!       DO iaer = 1, naerkind ! Loop on aerosol kind
+!         aerkind: SELECT CASE (iaer)
+! c==================================================================
+!         CASE(1) aerkind                             ! Dust (iaer=1)
+  c==================================================================
+  
+! c         Particule size distribution computed below will be used
+! c           only if there are more than one particule size in the
+! c           ASCII file which contains the scattering parameters
+! c           (see callradite.F for more information).
+! c         Dust particle size distribution is deduced from dust 
+! c           transport simulations. The resulting mean vertical size
+! c           distribution is fitted with a function of the form
+! c           f(x)= a+b*[1+tanh( (log(x)-c)/d )], f being the dust
+! c           particle radius and x the atmospheric pressure
+! c           in a given layer. Then it is used below to define a
+! c           "background" dust size distribution.
+! c         Effective variance is set to 0.3.
+  
+            DO l=1,nlayer
+              DO ig=1,ngrid
+!               reffrad(ig,l,iaer)=(log(pplay(ig,l)) - dustcoefc) /
+!      &                           dustcoefd
+!               reffrad(ig,l,iaer)=max(( (1.E0 + 
+!      &                                 tanh(reffrad(ig,l,iaer))) * 
+!      &                                 dustcoefb + dustcoefa ) *
+!      &                                 1E-6,1.E-9)
+!               nueffrad(ig,l,iaer)=0.3
+              ENDDO
+            ENDDO
+  
+  c==================================================================
+!         CASE(2) aerkind               ! Water ice crystals (iaer=2)
+  c==================================================================
+            DO l=1,nlayer
+              DO ig=1,ngrid
+!               reffrad(ig,l,iaer)=rice(ig,l)
+!               nueffrad(ig,l,iaer)=nuice(ig,l)
+              ENDDO
+            ENDDO
+  c==================================================================
+--- 63,175 ----
+        INTEGER :: ig,l          ! 3D grid indices
+        INTEGER :: iaer          ! Aerosol index
+  
+! c     Number of cloud condensation nuclei near the surface
+! c     (only used at firstcall). This value is taken from 
+! c     Montmessin et al. 2004 JGR 109 E10004 p5 (2E6 part m-3), and
+! c     converted to part kg-1 using a typical atmospheric density.
+! 
+!       REAL, PARAMETER :: ccn0 = 1.3E8
+! 
+!       LOGICAL firstcall
+!       DATA firstcall/.true./
+!       SAVE firstcall
+! 
+!       REAL CBRT
+!       EXTERNAL CBRT
+  
+  c     Local saved variables:
+  c     ---------------------
+  
+  c==================================================================
+! c 1. Radius used in the physical subroutines
+! c   (but not in the rad. transfer)
+  c==================================================================
+  
+! c     1.1 Dust particles
+! c     ------------------
+  
++       IF (doubleq.AND.active) THEN
++         DO l=1,nlayer
++           DO ig=1, ngrid
++             reffdust(ig,l) = ref_r0 *
++      &        CBRT(r3n_q*pq(ig,l,igcm_dust_mass)/
++      &        max(pq(ig,l,igcm_dust_number),0.01))
++             reffdust(ig,l)=min(max(reffdust(ig,l),1.e-10),500.e-6)
++             nueffdust(ig,l) = exp(varian**2.)-1.
++           ENDDO
++         ENDDO
++       ELSE
++         DO l=1,nlayer
++           DO ig=1, ngrid
++             reffdust(ig,l) = 1.5E-6
++             nueffdust(ig,l) = 0.3
++           ENDDO
++         ENDDO
++       ENDIF
++ 
++       DO l=1,nlayer
++         DO ig=1, ngrid
++ c         Geometric mean radius = Effective radius / (1+nueff)^5/2
++           rdust(ig,l) = reffdust(ig,l)/(1.+nueffdust(ig,l))**2.5
++         ENDDO
++       ENDDO
++ 
++ c     1.2 Water-ice particles
++ c     -----------------------
++ 
++       IF (firstcall.AND.water.AND.activice) THEN
+          DO l=1,nlayer
+            DO ig=1,ngrid
+!             rice(ig,l) = max( CBRT(
+!      &        (pq(ig,l,igcm_h2o_ice)/rho_ice +
+!      &        ccn0*(4./3.)*pi*rdust(ig,l)**3.) /
+!      &        (ccn0*4./3.*pi)),rdust(ig,l) )
+!             nuice(ig,l) = nuice_ref
+            ENDDO
+          ENDDO
++         firstcall = .false.
++       ENDIF
++ 
++ c==================================================================
++ c 2. Radius used in the radiative transfer code (reffrad)
++ c==================================================================
+  
++       DO iaer = 1, naerkind ! Loop on aerosol kind
++         aerkind: SELECT CASE (name_iaer(iaer))
++ c==================================================================
++         CASE("dust_conrath") aerkind         ! Typical dust profile
++ c==================================================================
++           DO l=1,nlayer
++             DO ig=1,ngrid
++               reffrad(ig,l,iaer) = reffdust(ig,l)
++               nueffrad(ig,l,iaer) = nueffdust(ig,l)
++             ENDDO
++           ENDDO
++ c==================================================================
++         CASE("dust_doubleq") aerkind! Two-moment scheme for dust
++ c==================================================================
++           DO l=1,nlayer
++             DO ig=1,ngrid
++               reffrad(ig,l,iaer) = reffdust(ig,l)
++               nueffrad(ig,l,iaer) = nueffdust(ig,l)
++             ENDDO
++           ENDDO
++ c==================================================================
++         CASE("dust_submicron") aerkind   ! Small dust population
++ c==================================================================
++           DO l=1,nlayer
++             DO ig=1,ngrid
++               reffrad(ig,l,iaer)=radius(igcm_dust_submicron)
++               nueffrad(ig,l,iaer)=0.03
++             ENDDO
++           ENDDO     
+  c==================================================================
+!         CASE("h2o_ice") aerkind             ! Water ice crystals
+  c==================================================================
+            DO l=1,nlayer
+              DO ig=1,ngrid
+!               reffrad(ig,l,iaer)=rice(ig,l)*(1.+nuice_ref)
+!               nueffrad(ig,l,iaer)=nuice_ref
+              ENDDO
+            ENDDO
+  c==================================================================
+*** libf/phymars/vdifc.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/vdifc.F	Thu Jun 10 15:08:31 2010
+***************
+*** 105,110 ****
+--- 105,112 ----
+        REAL qsat(ngridmx)
+        DATA firstcall/.true./
+  
++       REAL kmixmin
++ 
+  c    ** un petit test de coherence
+  c       --------------------------
+  
+***************
+*** 239,245 ****
+       &              ,pu,pv,ph,zcdv_true
+       &              ,pq2,zkv,zkh)
+  
+! 
+  
+  c    ** diagnostique pour le schema de turbulence
+  c       -----------------------------------------
+--- 241,255 ----
+       &              ,pu,pv,ph,zcdv_true
+       &              ,pq2,zkv,zkh)
+  
+!       if ((doubleq).and.(ngrid.eq.1)) then
+!         kmixmin = 80. !80.! minimum eddy mix coeff in 1D
+!         do ilev=1,nlay
+!           do ig=1,ngrid
+!            zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
+!            zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev))
+!           end do
+!         end do
+!       end if
+  
+  c    ** diagnostique pour le schema de turbulence
+  c       -----------------------------------------
+***************
+*** 446,460 ****
+  c       -----------------------------------------------------------
+          do ig=1,ngridmx  
+            rho(ig) = zb0(ig,1) /ptimestep
+! !          zb(ig,1) = 0.
+          end do
+  c       Dust lifting:
+          if (lifting) then 
+             call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+!      $                  pdqsdif)
+!        
+          else
+!            call zerophys(ngrid*nq,pdqsdif)
+          end if
+  
+  c       OU calcul de la valeur de q a la surface (water)  :
+--- 456,494 ----
+  c       -----------------------------------------------------------
+          do ig=1,ngridmx  
+            rho(ig) = zb0(ig,1) /ptimestep
+! c          zb(ig,1) = 0.
+          end do
+  c       Dust lifting:
+          if (lifting) then
++            if (doubleq.AND.submicron) then
++              do ig=1,ngrid
++ c              if(co2ice(ig).lt.1) then
++                  pdqsdif(ig,igcm_dust_mass) =
++      &             -alpha_lift(igcm_dust_mass)  
++                  pdqsdif(ig,igcm_dust_number) = 
++      &             -alpha_lift(igcm_dust_number)  
++                  pdqsdif(ig,igcm_dust_submicron) =
++      &             -alpha_lift(igcm_dust_submicron)
++ c              end if
++              end do
++            else if (doubleq) then
++              do ig=1,ngrid
++                  pdqsdif(ig,igcm_dust_mass) =
++      &             -alpha_lift(igcm_dust_mass)  
++                  pdqsdif(ig,igcm_dust_number) = 
++      &             -alpha_lift(igcm_dust_number)  
++              end do
++            else if (submicron) then
++              do ig=1,ngrid
++                  pdqsdif(ig,igcm_dust_submicron) =
++      &             -alpha_lift(igcm_dust_submicron)
++              end do
++            else
+              call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+!      &                    pdqsdif)
+!            endif !doubleq.AND.submicron
+          else
+!            pdqsdif(1:ngrid,1:nq) = 0.
+          end if
+  
+  c       OU calcul de la valeur de q a la surface (water)  :
+*** libf/phymars/watercloud.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/watercloud.F	Mon Jan 24 14:07:15 2011
+***************
+*** 2,15 ****
+       &                pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
+       &                pq,pdq,pdqcloud,pdqscloud,pdtcloud,
+       &                nq,naersize,tau,
+!      &                rnuclei,rice,nuice)
+        IMPLICIT NONE
+  
+  c=======================================================================
+  c     Treatment of saturation of water vapor
+  c
+  c
+! c     Modif de zq si saturation dans l'atmopshere
+  c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+  c     Le test est effectue de bas en haut. L'eau condensee
+  c    (si saturation) est remise dans la couche en dessous.
+--- 2,15 ----
+       &                pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
+       &                pq,pdq,pdqcloud,pdqscloud,pdtcloud,
+       &                nq,naersize,tau,
+!      &                ccn,rdust,rice,nuice)
+        IMPLICIT NONE
+  
+  c=======================================================================
+  c     Treatment of saturation of water vapor
+  c
+  c
+! c     Modif de zq si saturation dans l'atmosphere
+  c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+  c     Le test est effectue de bas en haut. L'eau condensee
+  c    (si saturation) est remise dans la couche en dessous.
+***************
+*** 52,68 ****
+        integer nq         ! nombre de traceurs 
+        integer naersize   ! nombre de traceurs radiativement actifs (=naerkind)
+        REAL tau(ngridmx,naersize)
+  
+  c   Outputs:
+  c   -------
+  
+        real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1)
+        real pdqscloud(ngrid,nq)     ! flux en surface (kg.m-2.s-1)
+!       REAL pdtcloud(ngrid,nlay)    ! tendance temperature due a la chaleur latente
+  
+!       REAL rnuclei(ngrid,nlay) ! Prescribed dust radius in each
+!                                !   layer (m)
+!       REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+        REAL nuice(ngrid,nlay)   ! Estimated effective variance
+                                 !   of the size distribution
+  
+--- 52,73 ----
+        integer nq         ! nombre de traceurs 
+        integer naersize   ! nombre de traceurs radiativement actifs (=naerkind)
+        REAL tau(ngridmx,naersize)
++       REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
++                                    !   (particules kg-1)
++ c     CCN reduction factor
++       REAL, PARAMETER :: ccn_factor = 1.
++       real rdust(ngridmx,nlayermx) ! Dust geometric mean radius (m)
+  
+  c   Outputs:
+  c   -------
+  
+        real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1)
+        real pdqscloud(ngrid,nq)     ! flux en surface (kg.m-2.s-1)
+!       REAL pdtcloud(ngrid,nlay)    ! tendance temperature due
+!                                    !   a la chaleur latente
+  
+!       REAL rice(ngrid,nlay)    ! Ice mass mean radius (m)
+!                                ! (r_c in montmessin_2004)
+        REAL nuice(ngrid,nlay)   ! Estimated effective variance
+                                 !   of the size distribution
+  
+***************
+*** 79,88 ****
+        REAL zqsat(ngridmx,nlayermx)    ! saturation
+        REAL zt(ngridmx,nlayermx)       ! local value of temperature
+  
+- 
+        REAL masse (ngridmx,nlayermx)
+        REAL epaisseur (ngridmx,nlayermx)
+-       REAL dustcores(ngridmx,nlayermx)  !Dust number density (#/kg) 
+        REAL rfinal        ! Ice crystal radius after condensation(m)
+        REAL seq           ! Equilibrium saturation ration (accounting for curvature effect)
+        REAL dzq           ! masse de glace echangee (kg/kg)
+--- 84,91 ----
+***************
+*** 106,112 ****
+        INTEGER i
+  
+  ! indexes of water vapour, water ice and dust tracers:
+-       INTEGER,SAVE :: i_dust=0 ! dust
+        INTEGER,SAVE :: i_h2o=0  ! water vapour
+        INTEGER,SAVE :: i_ice=0  ! water ice
+        CHARACTER(LEN=20) :: tracername ! to temporarly store text
+--- 108,113 ----
+***************
+*** 129,152 ****
+             stop
+          endif
+           
+-         do iq=1,nqmx
+-           tracername=noms(iq)
+-           if (tracername(1:4).eq."dust") then
+-             i_dust=iq
+-           endif
+- !          if (tracername.eq."h2o_ice") then
+- !            i_ice=iq
+- !          endif
+- !          if (tracername.eq."h2o_vap") then
+- !            i_h2o=iq
+- !          endif
+-         enddo
+          i_h2o=igcm_h2o_vap
+          i_ice=igcm_h2o_ice
+          
+!         write(*,*) "watercloud: i_dust=",i_dust
+          write(*,*) "            i_ice=",i_ice
+!         write(*,*) "            i_h2o=",i_h2o
+          
+          firstcall=.false.
+        ENDIF ! of IF (firstcall)
+--- 130,142 ----
+             stop
+          endif
+           
+          i_h2o=igcm_h2o_vap
+          i_ice=igcm_h2o_ice
+          
+!         write(*,*) "watercloud: i_h2o=",i_h2o
+          write(*,*) "            i_ice=",i_ice
+! 
+!         write(*,*) "water_param CCN reduction factor:", ccn_factor
+   
+          firstcall=.false.
+        ENDIF ! of IF (firstcall)
+***************
+*** 172,210 ****
+            zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
+            zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 
+            zq0(ig,l,i_ice)=zq(ig,l,i_ice)
+!           rnuclei(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+  c         Calcul du rayon moyen des particules de glace.
+  c         Hypothese : Dans une couche, la glace presente se
+  c         repartit uniformement autour du nbre de poussieres
+! c         dont le rayon moyen est prescrit par rnuclei.
+  c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-           if ((dustbin.eq.1).and.(.not.(doubleq))) then
+-             zq(ig,l,i_dust)=pq(ig,l,i_dust)+pdq(ig,l,i_dust)*ptimestep
+-               dustcores(ig,l)=max(zq(ig,l,i_dust)/
+-      &         (rho_dust*4./3.*pi*radius(i_dust)**3.),1.e-9)
+-           else
+-             dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+-      &     2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+- 
+- c            TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+- c              dustcores(ig,l) = dustcores(ig,l) / 27. ! reduction facteur 3
+-             dustcores(ig,l) = dustcores(ig,l) / 8. ! reduction facteur 2
+-           endif
+            rice(ig,l)=CBRT( ( zq(ig,l,i_ice)/rho_ice+
+!      &       dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3. )
+!      &       / (dustcores(ig,l)*4./3.*pi) )
+!           rice(ig,l)=max(rice(ig,l),rnuclei(ig,l))
+  c         Effective variance of the size distribution
+!           nuice(ig,l)=0.1
+          enddo ! of do ig=1,ngrid
+        enddo ! of dol=1,nlay
+  
+!       call zerophys(ngrid*nq,pdqscloud)
+!       call zerophys(ngrid*nlay*nq,pdqcloud)
+!       call zerophys(ngrid*nlay,pdtcloud)
+  
+! c     call zerophys(ngrid,icetot)
+! c     call zerophys(ngrid,rave)
+  
+  c    ----------------------------------------------
+  c
+--- 162,202 ----
+            zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
+            zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 
+            zq0(ig,l,i_ice)=zq(ig,l,i_ice)
+! 
+! c         This typical profile is not used anymore; rdust is
+! c           set up in updatereffrad.F.
+! c         rdust(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+!         enddo
+!       enddo
+! 
+!       do l=1,nlay
+!         do ig=1,ngrid
+!           ccn(ig,l) = ccn(ig,l) / ccn_factor
+! c         TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+! c         reduction facteur 3
+! c         ccn(ig,l) = ccn(ig,l) / 27.
+! c         reduction facteur 2
+! c         ccn(ig,l) = ccn(ig,l) / 8.
+  c         Calcul du rayon moyen des particules de glace.
+  c         Hypothese : Dans une couche, la glace presente se
+  c         repartit uniformement autour du nbre de poussieres
+! c         dont le rayon moyen est prescrit par rdust.
+  c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            rice(ig,l)=CBRT( ( zq(ig,l,i_ice)/rho_ice+
+!      &       ccn(ig,l)*(4./3.)*pi*rdust(ig,l)**3. )
+!      &       / (ccn(ig,l)*4./3.*pi) )
+!           rice(ig,l)=max(rice(ig,l),rdust(ig,l))
+  c         Effective variance of the size distribution
+!           nuice(ig,l)=nuice_ref
+          enddo ! of do ig=1,ngrid
+        enddo ! of dol=1,nlay
+  
+!       pdqscloud(1:ngrid,1:nq)=0
+!       pdqcloud(1:ngrid,1:nlay,1:nq)=0
+!       pdtcloud(1:ngrid,1:nlay)=0
+  
+! c     icetot(1:ngrid)=0
+! c     rave(1:ngrid)=0
+  
+  c    ----------------------------------------------
+  c
+***************
+*** 234,240 ****
+             call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+       &        ph2o,ph2o/satu,seq,rice(ig,l),gr)
+             Cste = ptimestep * 4. * pi * rice(ig,l)
+!      *              * rho_ice * dustcores(ig,l)
+             up   = zq(ig,l,i_h2o) + Cste * gr * seq
+             dwn  =    1.       + Cste * gr / zqsat(ig,l)
+             newvap = min(up/dwn,Ctot)
+--- 226,232 ----
+             call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+       &        ph2o,ph2o/satu,seq,rice(ig,l),gr)
+             Cste = ptimestep * 4. * pi * rice(ig,l)
+!      *              * rho_ice * ccn(ig,l)
+             up   = zq(ig,l,i_h2o) + Cste * gr * seq
+             dwn  =    1.       + Cste * gr / zqsat(ig,l)
+             newvap = min(up/dwn,Ctot)
+***************
+*** 267,274 ****
+              zq(ig,l,i_h2o)=zq(ig,l,i_h2o)-dzq
+  
+              rice(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_ice
+!      &       +dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3.)
+!      &       /(dustcores(ig,l)*4./3.*pi) ), rnuclei(ig,l)) 
+  
+              enddo ! of do ig=1,ngrid
+            enddo ! of do l=1,nlay
+--- 259,266 ----
+              zq(ig,l,i_h2o)=zq(ig,l,i_h2o)-dzq
+  
+              rice(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_ice
+!      &       +ccn(ig,l)*(4./3.)*pi*rdust(ig,l)**3.)
+!      &       /(ccn(ig,l)*4./3.*pi) ), rdust(ig,l)) 
+  
+              enddo ! of do ig=1,ngrid
+            enddo ! of do l=1,nlay
+***************
+*** 344,351 ****
+  c        enddo   ! (ngridmx)
+  c**************************************************
+  
+-  99   continue
+- 
+        RETURN
+        END
+   
+--- 336,341 ----
+*** libf/phymars/writediagfi.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/writediagfi.F	Fri Sep  3 09:32:50 2010
+***************
+*** 5,11 ****
+  !  3d (ex : temperature), 2d (ex : temperature de surface), ou
+  !  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+  !  solaire)
+! !  Dans la version 2000, la periode d'ecriture est celle de 
+  !  "ecritphy " regle dans le fichier de controle de run :  run.def
+  !
+  !    writediagfi peut etre appele de n'importe quelle subroutine
+--- 5,12 ----
+  !  3d (ex : temperature), 2d (ex : temperature de surface), ou
+  !  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+  !  solaire)
+! !  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
+! !  La periode d'ecriture est donnee par 
+  !  "ecritphy " regle dans le fichier de controle de run :  run.def
+  !
+  !    writediagfi peut etre appele de n'importe quelle subroutine
+***************
+*** 19,24 ****
+--- 20,26 ----
+  ! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+  ! avant l'ecriture dans diagfi (cf. physiq.F)
+  !  
++ ! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
+  !
+  !  parametres (input) :
+  !  ----------
+***************
+*** 30,37 ****
+  !      nom  : nom de la variable a sortir (chaine de caracteres)
+  !      titre: titre de la variable (chaine de caracteres)
+  !      unite : unite de la variable (chaine de caracteres)
+! !      px : variable a sortir (real 0, 2, ou 3d)
+! !      dim : dimension de px : 0, 2, ou 3 dimensions
+  !
+  !=================================================================
+   
+--- 32,39 ----
+  !      nom  : nom de la variable a sortir (chaine de caracteres)
+  !      titre: titre de la variable (chaine de caracteres)
+  !      unite : unite de la variable (chaine de caracteres)
+! !      px : variable a sortir (real 0, 1, 2, ou 3d)
+! !      dim : dimension de px : 0, 1, 2, ou 3 dimensions
+  !
+  !=================================================================
+   
+***************
+*** 57,67 ****
+  
+  ! Local variables:
+  
+!       real dx3(iip1,jjp1,llm) ! to store a 3D data set
+!       real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+!       real dx0
+  
+!       real date
+  
+        REAL phis(ip1jmp1)
+  
+--- 59,70 ----
+  
+  ! Local variables:
+  
+!       real*4 dx3(iip1,jjp1,llm) ! to store a 3D data set
+!       real*4 dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+!       real*4 dx1(llm)           ! to store a 1D (column) data set
+!       real*4 dx0
+  
+!       real*4 date
+  
+        REAL phis(ip1jmp1)
+  
+***************
+*** 98,110 ****
+  
+  !***************************************************************
+  
+- ! The following test is here to enforce that writediagfi is not used with the
+- ! 1D version of the GCM
+-       if (ngrid.eq.1) return
+-       
+- c     nom=trim((nom))
+- c     unite=trim((unite))
+- c     titre=trim((titre))
+  
+  ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+  ! ------------------------------------------------------------------------
+--- 101,106 ----
+***************
+*** 128,138 ****
+           ! Define the 'Time' dimension
+           ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+           ! Define the 'Time' variable
+! #ifdef NC_DOUBLE
+!          ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+! #else
+           ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+! #endif
+           ! Add a long_name attribute
+           ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+       .          4,"Time")
+--- 124,134 ----
+           ! Define the 'Time' dimension
+           ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+           ! Define the 'Time' variable
+! !#ifdef NC_DOUBLE
+! !         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+! !#else
+           ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+! !#endif
+           ! Add a long_name attribute
+           ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+       .          4,"Time")
+***************
+*** 152,157 ****
+--- 148,161 ----
+           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+        endif ! if (firstnom.eq.'1234567890')
+  
++       if (ngridmx.eq.1) then
++         ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
++         ! are undefined; so set them to 1
++         iphysiq=1 
++         irythme=1
++         ! NB: 
++       endif
++ 
+  ! Increment time index 'zitau' if it is the "fist call" (at given time level)
+  ! to writediagfi
+  !------------------------------------------------------------------------
+***************
+*** 168,174 ****
+  ! Compute/write/extend 'Time' coordinate (date given in days)
+  ! (done every "first call" (at given time level) to writediagfi)
+  ! Note: date is incremented as 1 step ahead of physics time
+- !       (like the 'histoire' outputs)
+  !--------------------------------------------------------
+  
+          if (nom.eq.firstnom) then
+--- 172,177 ----
+***************
+*** 179,189 ****
+             ! Get NetCDF ID of 'Time' variable
+             ierr= NF_INQ_VARID(nid,"Time",varid)
+             ! Write (append) the new date to the 'Time' array
+! #ifdef NC_DOUBLE
+!            ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+! #else
+             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+! #endif
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+                write(*,*) "***** with time"
+--- 182,192 ----
+             ! Get NetCDF ID of 'Time' variable
+             ierr= NF_INQ_VARID(nid,"Time",varid)
+             ! Write (append) the new date to the 'Time' array
+! !#ifdef NC_DOUBLE
+! !           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+! !#else
+             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+! !#endif
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+                write(*,*) "***** with time"
+***************
+*** 244,254 ****
+             edges(2)=jjp1
+             edges(3)=llm
+             edges(4)=1
+! #ifdef NC_DOUBLE
+!            ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+! #else
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+! #endif
+  
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR problem in writediagfi"
+--- 247,257 ----
+             edges(2)=jjp1
+             edges(3)=llm
+             edges(4)=1
+! !#ifdef NC_DOUBLE
+! !           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+! !#else
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+! !#endif
+  
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR problem in writediagfi"
+***************
+*** 303,313 ****
+             edges(3)=1
+  
+  
+! #ifdef NC_DOUBLE
+!            ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+! #else         
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+! #endif     
+  
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi"
+--- 306,316 ----
+             edges(3)=1
+  
+  
+! !#ifdef NC_DOUBLE
+! !           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+! !#else         
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+! !#endif     
+  
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi"
+***************
+*** 316,321 ****
+--- 319,367 ----
+  c             call abort
+             endif 
+  
++ !Case of a 1D variable (ie: a column)
++ !---------------------------------------------------
++ 
++        else if (dim.eq.1) then
++ !         Passage variable physique -->  physique dynamique
++ !         recast (copy) variable from physics grid to dynamics grid
++           do l=1,llm
++             dx1(l)=px(1,l)
++           enddo
++           
++           ierr= NF_INQ_VARID(nid,nom,varid)
++            if (ierr /= NF_NOERR) then
++ ! corresponding dimensions
++               ierr= NF_INQ_DIMID(nid,"altitude",id(1))
++               ierr= NF_INQ_DIMID(nid,"Time",id(2))
++ 
++ ! Create the variable if it doesn't exist yet
++ 
++               write (*,*) "=========================="
++               write (*,*) "DIAGFI: creating variable ",nom
++ 
++               call def_var(nid,nom,titre,unite,2,id,varid,ierr)
++               
++            endif
++            
++            corner(1)=1
++            corner(2)=ntime
++            
++            edges(1)=llm
++            edges(2)=1
++ !#ifdef NC_DOUBLE
++ !           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1)
++ !#else
++            ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1)
++ !#endif
++ 
++            if (ierr.ne.NF_NOERR) then
++               write(*,*) "***** PUT_VAR problem in writediagfi"
++               write(*,*) "***** with ",nom
++               write(*,*) 'ierr=', ierr
++ c             call abort
++            endif 
++ 
+  !Case of a 0D variable (ie: a time-dependent scalar)
+  !---------------------------------------------------
+  
+***************
+*** 339,349 ****
+             corner(1)=ntime
+             edges(1)=1
+  
+! #ifdef NC_DOUBLE
+!            ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+! #else
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+! #endif
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi"
+                write(*,*) "***** with ",nom
+--- 385,395 ----
+             corner(1)=ntime
+             edges(1)=1
+  
+! !#ifdef NC_DOUBLE
+! !           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+! !#else
+             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+! !#endif
+             if (ierr.ne.NF_NOERR) then
+                write(*,*) "***** PUT_VAR matter in writediagfi"
+                write(*,*) "***** with ",nom
+*** libf/phymars/wstats.F90	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/wstats.F90	Fri Sep  3 11:43:34 2010
+***************
+*** 8,18 ****
+  #include "netcdf.inc"
+  
+  integer,intent(in) :: ngrid
+! character (len=*) :: nom,titre,unite
+  integer,intent(in) :: dim
+  integer,parameter :: iip1=iim+1
+  integer,parameter :: jjp1=jjm+1
+- real, dimension(ngrid,llm) :: px
+  real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+  real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+  character (len=50) :: namebis
+--- 8,18 ----
+  #include "netcdf.inc"
+  
+  integer,intent(in) :: ngrid
+! character (len=*),intent(in) :: nom,titre,unite
+  integer,intent(in) :: dim
++ real, dimension(ngrid,llm),intent(in) :: px
+  integer,parameter :: iip1=iim+1
+  integer,parameter :: jjp1=jjm+1
+  real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+  real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+  character (len=50) :: namebis
+***************
+*** 71,80 ****
+     write (*,*) "====================="
+     write (*,*) "STATS: creation de ",nom
+     namebis=trim(nom)
+!    call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+     call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+     namebis=trim(nom)//"_sd"
+!    call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+     call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+  
+     ierr= NF_CLOSE(nid)
+--- 71,80 ----
+     write (*,*) "====================="
+     write (*,*) "STATS: creation de ",nom
+     namebis=trim(nom)
+!    call def_var_stats(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+     call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+     namebis=trim(nom)//"_sd"
+!    call def_var_stats(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+     call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+  
+     ierr= NF_CLOSE(nid)
+***************
+*** 157,164 ****
+        ENDDO
+     ENDDO
+  
+!    mean3d= mean3d+dx3
+!    sd3d= sd3d+dx3**2
+  
+  #ifdef NC_DOUBLE
+     ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+--- 157,164 ----
+        ENDDO
+     ENDDO
+  
+!    mean3d(:,:,:)= mean3d(:,:,:)+dx3(:,:,:)
+!    sd3d(:,:,:)= sd3d(:,:,:)+dx3(:,:,:)**2
+  
+  #ifdef NC_DOUBLE
+     ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+***************
+*** 167,172 ****
+--- 167,176 ----
+     ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+     ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+  #endif
++    if (ierr.ne.NF_NOERR) then
++      write (*,*) NF_STRERROR(ierr)
++      stop ""
++    endif
+  
+  else if (dim.eq.2) then
+  
+***************
+*** 184,191 ****
+       dx2(iip1,j)=dx2(1,j)
+    ENDDO
+  
+!    mean2d= mean2d+dx2
+!    sd2d= sd2d+dx2**2
+  
+  #ifdef NC_DOUBLE
+     ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+--- 188,195 ----
+       dx2(iip1,j)=dx2(1,j)
+    ENDDO
+  
+!    mean2d(:,:)= mean2d(:,:)+dx2(:,:)
+!    sd2d(:,:)= sd2d(:,:)+dx2(:,:)**2
+  
+  #ifdef NC_DOUBLE
+     ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+***************
+*** 194,205 ****
+     ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+     ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+  #endif
+  
+  endif
+  
+  ierr= NF_CLOSE(nid)
+  
+! end
+  
+  !======================================================
+  subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+--- 198,213 ----
+     ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+     ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+  #endif
++    if (ierr.ne.NF_NOERR) then
++      write (*,*) NF_STRERROR(ierr)
++      stop ""
++    endif
+  
+  endif
+  
+  ierr= NF_CLOSE(nid)
+  
+! end subroutine wstats
+  
+  !======================================================
+  subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+***************
+*** 276,279 ****
+  
+  endif
+  
+! end
+--- 284,352 ----
+  
+  endif
+  
+! end subroutine inivar
+! 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 
+! subroutine def_var_stats(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+! 
+! ! This subroutine defines variable 'name' in a (pre-existing and opened)
+! ! NetCDF file (known from its NetCDF ID 'nid').
+! ! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+! ! corresponding dimensions must be set (in array 'dimids').
+! ! Upon successfull definition of the variable, 'nvarid' contains the
+! ! NetCDF ID of the variable.
+! ! The variables' attributes 'title' (Note that 'long_name' would be more
+! ! appropriate) and 'units' are also set. 
+! 
+! implicit none
+! 
+! #include "netcdf.inc"
+! 
+! integer,intent(in) :: nid ! NetCDF file ID
+! character(len=*),intent(in) :: name ! the variable's name
+! character(len=*),intent(in) :: title ! 'title' attribute of variable
+! character(len=*),intent(in) :: units ! 'units' attribute of variable
+! integer,intent(in) :: nbdim ! number of dimensions of the variable
+! integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+!                                               ! the variable is defined along
+! integer,intent(out) :: nvarid ! NetCDF ID of the variable
+! integer,intent(out) :: ierr ! returned NetCDF staus code
+! 
+! ! 1. Switch to NetCDF define mode 
+! ierr=NF_REDEF(nid)
+! 
+! ! 2. Define the variable
+! #ifdef NC_DOUBLE
+! ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+! #else
+! ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+! #endif
+! if(ierr/=NF_NOERR) then
+!    write(*,*) "def_var_stats: Failed defining variable "//trim(name)
+!    write(*,*) NF_STRERROR(ierr)
+!    stop ""
+! endif
+! 
+! ! 3. Write attributes
+! ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+!                      len_trim(adjustl(title)),adjustl(title))
+! if(ierr/=NF_NOERR) then
+!    write(*,*) "def_var_stats: Failed writing title attribute for "//trim(name)
+!    write(*,*) NF_STRERROR(ierr)
+!    stop ""
+! endif
+! 
+! ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+!                      len_trim(adjustl(units)),adjustl(units))
+! if(ierr/=NF_NOERR) then
+!    write(*,*) "def_var_stats: Failed writing units attribute for "//trim(name)
+!    write(*,*) NF_STRERROR(ierr)
+!    stop ""
+! endif
+! 
+! ! 4. Switch out of NetCDF define mode
+! ierr = NF_ENDDEF(nid)
+! 
+! end subroutine def_var_stats
+! 
+*** libf/phymars/writediagsoil.F90	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/writediagsoil.F90	Fri Sep  3 09:46:37 2010
+***************
+*** 9,14 ****
+--- 9,16 ----
+  ! that this routine is called with given 'name'; otherwise data is appended
+  ! (yielding the sought time series of the variable)
+  
++ ! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
++ 
+  implicit none
+  
+  #include"dimensions.h"
+***************
+*** 29,42 ****
+  ! Note: nsoilmx is a common parameter set in 'dimphys.h'
+  
+  ! Local variables:
+! real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+  ! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h
+! real,dimension(iip1,jjp1) :: data2 ! to store 2D data
+! real :: data0 ! to store 0D data
+  integer :: i,j,l ! for loops
+  integer :: ig0
+  
+! real,save :: date ! time counter (in elapsed days)
+  integer,save :: isample ! sample rate at which data is to be written to output
+  integer,save :: ntime=0 ! counter to internally store time steps
+  character(len=20),save :: firstname="1234567890"
+--- 31,44 ----
+  ! Note: nsoilmx is a common parameter set in 'dimphys.h'
+  
+  ! Local variables:
+! real*4,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+  ! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h
+! real*4,dimension(iip1,jjp1) :: data2 ! to store 2D data
+! real*4 :: data0 ! to store 0D data
+  integer :: i,j,l ! for loops
+  integer :: ig0
+  
+! real*4,save :: date ! time counter (in elapsed days)
+  integer,save :: isample ! sample rate at which data is to be written to output
+  integer,save :: ntime=0 ! counter to internally store time steps
+  character(len=20),save :: firstname="1234567890"
+***************
+*** 100,116 ****
+  ! 3.1 If first call at this date, update 'time' variable
+    if (name.eq.firstname) then
+      ntime=ntime+1
+!     date=float(zitau+1)/float(day_step)
+      ! Note: day_step is known from control.h
+      
+      ! Get NetCDF ID for "time"
+      ierr=NF_INQ_VARID(nid,"time",varid)
+      ! Add the current value of date to the "time" array
+! #ifdef NC_DOUBLE
+!     ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+! #else
+      ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+! #endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*)"writediagsoil: Failed writing date to time variable"
+        stop 
+--- 102,118 ----
+  ! 3.1 If first call at this date, update 'time' variable
+    if (name.eq.firstname) then
+      ntime=ntime+1
+!     date=real(zitau+1)/real(day_step)
+      ! Note: day_step is known from control.h
+      
+      ! Get NetCDF ID for "time"
+      ierr=NF_INQ_VARID(nid,"time",varid)
+      ! Add the current value of date to the "time" array
+! !#ifdef NC_DOUBLE
+! !    ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+! !#else
+      ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+! !#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*)"writediagsoil: Failed writing date to time variable"
+        stop 
+***************
+*** 165,175 ****
+    edges(4)=1
+    
+    ! B.3. Write the slab of data
+! #ifdef NC_DOUBLE
+!   ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
+! #else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+! #endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+--- 167,177 ----
+    edges(4)=1
+    
+    ! B.3. Write the slab of data
+! !#ifdef NC_DOUBLE
+! !  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
+! !#else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+! !#endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+***************
+*** 217,227 ****
+    edges(3)=1
+    
+    ! B.3. Write the slab of data
+! #ifdef NC_DOUBLE
+!   ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
+! #else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+! #endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+--- 219,229 ----
+    edges(3)=1
+    
+    ! B.3. Write the slab of data
+! !#ifdef NC_DOUBLE
+! !  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
+! !#else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+! !#endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+***************
+*** 251,261 ****
+    edges(1)=1
+  
+    ! B.3. Write the data
+! #ifdef NC_DOUBLE
+!   ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
+! #else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
+! #endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+--- 253,263 ----
+    edges(1)=1
+  
+    ! B.3. Write the data
+! !#ifdef NC_DOUBLE
+! !  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
+! !#else
+    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
+! !#endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+                 " to file "//trim(filename)//" at time",date
+*** libf/phymars/soil_settings.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/soil_settings.F	Fri Sep  3 09:20:22 2010
+***************
+*** 1,4 ****
+--- 1,6 ----
+        subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil)
++ 
++       use netcdf
+        implicit none
+  
+  !======================================================================
+***************
+*** 6,11 ****
+--- 8,17 ----
+  !
+  !  Purpose: Read and/or initialise soil depths and properties
+  !
++ ! Modifications: Aug.2010 EM : use NetCDF90 to load variables (enables using
++ !                      r4 or r8 restarts independently of having compiled
++ !                      the GCM in r4 or r8)
++ !
+  !  This subroutine reads from a NetCDF file (opened by the caller)
+  !  of "startfi.nc" format.
+  !  The various actions and variable read/initialized are:
+***************
+*** 26,32 ****
+  #include "dimphys.h"
+  
+  #include "comsoil.h"
+! #include "netcdf.inc"
+  !======================================================================
+  !  arguments
+  !  ---------
+--- 32,38 ----
+  #include "dimphys.h"
+  
+  #include "comsoil.h"
+! !#include "netcdf.inc"
+  !======================================================================
+  !  arguments
+  !  ---------
+***************
+*** 73,88 ****
+  
+  ! 1.1 Start by reading how many layers of soil there are
+  
+! 	ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+! 	if (ierr.ne.NF_NOERR) then
+  	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
+  	 call abort
+  	endif
+  
+! 	ierr=NF_INQ_DIMLEN(nid,dimid,dimlen)
+! 	if (ierr.ne.NF_NOERR) then
+  	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
+       &             'length'
+  	 call abort
+  	endif
+  
+--- 79,96 ----
+  
+  ! 1.1 Start by reading how many layers of soil there are
+  
+! 	ierr=nf90_inq_dimid(nid,"subsurface_layers",dimid)
+! 	if (ierr.ne.nf90_noerr) then
+  	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
++          write(*,*)trim(nf90_strerror(ierr))
+  	 call abort
+  	endif
+  
+! 	ierr=nf90_inquire_dimension(nid,dimid,len=dimlen)
+! 	if (ierr.ne.nf90_noerr) then
+  	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
+       &             'length'
++ 	 write(*,*)trim(nf90_strerror(ierr))
+           call abort
+  	endif
+  
+***************
+*** 97,110 ****
+  ! 1.2 Find out the # of dimensions <inertiedat> was defined as using
+  !     (in ye old days, thermal inertia was only given at the "surface")
+        ! Look for thermal inertia data
+!       ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+!       if (ierr.NE.NF_NOERR) then
+           write(*,*)'soil_settings: Field <inertiedat> not found!'
+           call abort
+        endif
+  
+        ! Read the # of dimensions <inertidat> was defined as using
+!       ierr=NF_INQ_VARNDIMS(nid,nvarid,ndims)
+        ! if (ndims.eq.1) then we have the "old 2D-surface" format
+  
+  ! 1.3 Read depths values or set olddepthdef flag and values
+--- 105,119 ----
+  ! 1.2 Find out the # of dimensions <inertiedat> was defined as using
+  !     (in ye old days, thermal inertia was only given at the "surface")
+        ! Look for thermal inertia data
+!       ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
+!       if (ierr.NE.nf90_noerr) then
+           write(*,*)'soil_settings: Field <inertiedat> not found!'
++          write(*,*)trim(nf90_strerror(ierr))
+           call abort
+        endif
+  
+        ! Read the # of dimensions <inertidat> was defined as using
+!       ierr=nf90_inquire_variable(nid,nvarid,ndims=ndims)
+        ! if (ndims.eq.1) then we have the "old 2D-surface" format
+  
+  ! 1.3 Read depths values or set olddepthdef flag and values
+***************
+*** 125,154 ****
+  	  oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.)
+  	enddo
+        else ! Look for depth 
+!         ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+!         if (ierr.ne.NF_NOERR) then
+            write(*,*)'soil_settings: Field <soildepth> not found!'
+  	  call abort
+          endif
+          ! read <depth> coordinate
+          if (interpol) then !put values in oldmlayer
+! #ifdef NC_DOUBLE
+!            ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldmlayer)
+! #else
+!            ierr = NF_GET_VAR_REAL(nid,nvarid,oldmlayer)
+! #endif
+!           if (ierr.ne.NF_NOERR) then
+             write(*,*)'soil_settings: Problem while reading <soildepth>'
+             call abort
+            endif
+          else ! put values in mlayer
+! #ifdef NC_DOUBLE
+!            ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+! #else
+!            ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+! #endif
+!           if (ierr.ne.NF_NOERR) then
+             write(*,*)'soil_settings: Problem while reading <soildepth>'
+             call abort
+            endif
+          endif !of if (interpol)
+--- 134,158 ----
+  	  oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.)
+  	enddo
+        else ! Look for depth 
+!         ierr=nf90_inq_varid(nid,"soildepth",nvarid)
+!         if (ierr.ne.nf90_noerr) then
+            write(*,*)'soil_settings: Field <soildepth> not found!'
++           write(*,*)trim(nf90_strerror(ierr))
+  	  call abort
+          endif
+          ! read <depth> coordinate
+          if (interpol) then !put values in oldmlayer
+!           ierr=nf90_get_var(nid,nvarid,oldmlayer)
+!           if (ierr.ne.nf90_noerr) then
+             write(*,*)'soil_settings: Problem while reading <soildepth>'
++            write(*,*)trim(nf90_strerror(ierr))
+             call abort
+            endif
+          else ! put values in mlayer
+!           ierr=nf90_get_var(nid,nvarid,mlayer)
+!           if (ierr.ne.nf90_noerr) then
+             write(*,*)'soil_settings: Problem while reading <soildepth>'
++            write(*,*)trim(nf90_strerror(ierr))
+             call abort
+            endif
+          endif !of if (interpol)
+***************
+*** 190,196 ****
+        endif
+  ! Look for it
+  !      ierr=NF_INQ_VARID(nid,"volcapa",nvarid)
+! !      if (ierr.NE.NF_NOERR) then
+  !         write(*,*)'soil_settings: Field <volcapa> not found!'
+  !         write(*,*)'Initializing Volumetric heat capacity to ',
+  !     &             default_volcapa
+--- 194,200 ----
+        endif
+  ! Look for it
+  !      ierr=NF_INQ_VARID(nid,"volcapa",nvarid)
+! !      if (ierr.NE.nf90_noerr) then
+  !         write(*,*)'soil_settings: Field <volcapa> not found!'
+  !         write(*,*)'Initializing Volumetric heat capacity to ',
+  !     &             default_volcapa
+***************
+*** 201,207 ****
+  !#else
+  !       ierr = NF_GET_VAR_REAL(nid,nvarid,volcapa)
+  !#endif
+! !        if (ierr.ne.NF_NOERR) then
+  !	  write(*,*)'soil_settings: Problem while reading <volcapa>'
+  !         call abort
+  !	endif
+--- 205,211 ----
+  !#else
+  !       ierr = NF_GET_VAR_REAL(nid,nvarid,volcapa)
+  !#endif
+! !        if (ierr.ne.nf90_noerr) then
+  !	  write(*,*)'soil_settings: Problem while reading <volcapa>'
+  !         call abort
+  !	endif
+***************
+*** 211,219 ****
+  ! ------------------
+  
+  ! 3.1 Look (again) for thermal inertia data (to reset nvarid)
+!       ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+!       if (ierr.NE.NF_NOERR) then
+           write(*,*)'soil_settings: Field <inertiedat> not found!'
+           call abort
+        endif
+  
+--- 215,224 ----
+  ! ------------------
+  
+  ! 3.1 Look (again) for thermal inertia data (to reset nvarid)
+!       ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
+!       if (ierr.NE.nf90_noerr) then
+           write(*,*)'soil_settings: Field <inertiedat> not found!'
++          write(*,*)trim(nf90_strerror(ierr))
+           call abort
+        endif
+  
+***************
+*** 225,237 ****
+       &e data!'
+         ! Read Surface thermal inertia
+         allocate(surfinertia(ngrid))
+! #ifdef NC_DOUBLE
+!        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, surfinertia)
+! #else
+!        ierr = NF_GET_VAR_REAL(nid, nvarid, surfinertia)
+! #endif
+!         if (ierr.NE.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
+           call abort
+          endif
+         
+--- 230,239 ----
+       &e data!'
+         ! Read Surface thermal inertia
+         allocate(surfinertia(ngrid))
+!        ierr=nf90_get_var(nid,nvarid,surfinertia)
+!         if (ierr.NE.nf90_noerr) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
++          write(*,*)trim(nf90_strerror(ierr))
+           call abort
+          endif
+         
+***************
+*** 252,274 ****
+              stop
+             endif
+           endif
+! #ifdef NC_DOUBLE
+!         ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldinertiedat)
+! #else
+!         ierr = NF_GET_VAR_REAL(nid,nvarid,oldinertiedat)
+! #endif
+!         if (ierr.NE.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
+           call abort
+          endif
+         else ! put values in therm_i
+! #ifdef NC_DOUBLE
+!         ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedat)
+! #else
+!         ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedat)
+! #endif
+!         if (ierr.NE.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
+           call abort
+          endif
+         endif ! of if (interpol)
+--- 254,270 ----
+              stop
+             endif
+           endif
+!          ierr=nf90_get_var(nid,nvarid,oldinertiedat)
+!         if (ierr.NE.nf90_noerr) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
++          write(*,*)trim(nf90_strerror(ierr))
+           call abort
+          endif
+         else ! put values in therm_i
+!         ierr=nf90_get_var(nid,nvarid,inertiedat)
+!         if (ierr.NE.nf90_noerr) then
+           write(*,*)'soil_settings: Problem while reading <inertiedat>'
++          write(*,*)trim(nf90_strerror(ierr))
+           call abort
+          endif
+         endif ! of if (interpol)
+***************
+*** 277,284 ****
+  ! 4. Read soil temperatures
+  ! -------------------------
+  
+!       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+          write(*,*)'soil_settings: Field <tsoil> not found!'
+  	write(*,*)' => Building <tsoil> from surface values <tsurf>'
+  	do iloop=1,nsoil
+--- 273,280 ----
+  ! 4. Read soil temperatures
+  ! -------------------------
+  
+!       ierr=nf90_inq_varid(nid,"tsoil",nvarid)
+!       if (ierr.ne.nf90_noerr) then
+          write(*,*)'soil_settings: Field <tsoil> not found!'
+  	write(*,*)' => Building <tsoil> from surface values <tsurf>'
+  	do iloop=1,nsoil
+***************
+*** 294,316 ****
+               stop
+             endif
+           endif
+! #ifdef NC_DOUBLE
+!         ierr=NF_GET_VAR_DOUBLE(nid,nvarid,oldtsoil)
+! #else
+!         ierr=NF_GET_VAR_REAL(nid,nvarid,oldtsoil)
+! #endif
+!         if (ierr.ne.NF_NOERR) then
+  	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+  	 call abort
+  	endif
+         else ! put values in tsoil
+! #ifdef NC_DOUBLE
+!         ierr=NF_GET_VAR_DOUBLE(nid,nvarid,tsoil)
+! #else
+!         ierr=NF_GET_VAR_REAL(nid,nvarid,tsoil)
+! #endif
+!         if (ierr.ne.NF_NOERR) then
+  	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+  	 call abort
+  	endif
+         endif ! of if (interpol) 
+--- 290,306 ----
+               stop
+             endif
+           endif
+!         ierr=nf90_get_var(nid,nvarid,oldtsoil)
+!         if (ierr.ne.nf90_noerr) then
+  	 write(*,*)'soil_settings: Problem while reading <tsoil>'
++          write(*,*)trim(nf90_strerror(ierr))
+  	 call abort
+  	endif
+         else ! put values in tsoil
+!         ierr=nf90_get_var(nid,nvarid,tsoil)
+!         if (ierr.ne.nf90_noerr) then
+  	 write(*,*)'soil_settings: Problem while reading <tsoil>'
++          write(*,*)trim(nf90_strerror(ierr))
+  	 call abort
+  	endif
+         endif ! of if (interpol) 
+*** libf/phymars/swr_toon.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/swr_toon.F	Wed Apr 28 16:11:08 2010
+***************
+*** 527,529 ****
+--- 527,530 ----
+  
+        RETURN
+        END
++       
+*** libf/phymars/callradite.F	Tue Jan 25 16:49:09 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/callradite.F	Wed Jan 12 15:19:14 2011
+***************
+*** 1,7 ****
+        SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+       $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+       $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+!      &     tauref,tau,aerosol,rice,nuice)
+  
+         IMPLICIT NONE
+  c=======================================================================
+--- 1,7 ----
+        SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+       $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+       $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+!      &     tauref,tau,aerosol,ccn,rdust,rice,nuice)
+  
+         IMPLICIT NONE
+  c=======================================================================
+***************
+*** 53,59 ****
+  c   constantly used by the subroutine "aeroptproperties.F" to compute,
+  c   online, the 3D scattering parameters, based on the size distribution
+  c   (reffrad and nueffrad) of the different tracers, in each grid box.
+! c   This 3D size distribution is loaded by the "updatereffrad.F"
+  c   subroutine. A log-normal distribution is then assumed in
+  c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+  c---- The optical depth at the visible reference wavelength (set in
+--- 53,59 ----
+  c   constantly used by the subroutine "aeroptproperties.F" to compute,
+  c   online, the 3D scattering parameters, based on the size distribution
+  c   (reffrad and nueffrad) of the different tracers, in each grid box.
+! c   These 3D size distributions are loaded by the "updatereffrad.F"
+  c   subroutine. A log-normal distribution is then assumed in
+  c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+  c---- The optical depth at the visible reference wavelength (set in
+***************
+*** 149,155 ****
+  #include "comcstfi.h"
+  #include "callkeys.h"
+  #include "yomlw.h"
+! 
+  
+  c-----------------------------------------------------------------------
+  c    Input/Output
+--- 149,155 ----
+  #include "comcstfi.h"
+  #include "callkeys.h"
+  #include "yomlw.h"
+! #include "aerkind.h"
+  
+  c-----------------------------------------------------------------------
+  c    Input/Output
+***************
+*** 159,164 ****
+--- 159,166 ----
+        INTEGER igout
+  
+        REAL pq(ngrid,nlayer,nq)
++       REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
++                                    !   (particules kg-1)
+        REAL albedo(ngrid,2),emis(ngrid)
+        REAL ls,zday
+  
+***************
+*** 172,184 ****
+  
+        REAL tauref(ngrid), tau(ngrid,naerkind)
+        REAL aerosol(ngrid,nlayer,naerkind)
+!       REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+        REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+  c
+  c    Local variables :
+  c    -----------------
+  
+!       INTEGER j,l,ig,n,ich,iaer
+        INTEGER jd,ig0,nd
+  
+        real  cste_mars ! solar constant on Mars (Wm-2)
+--- 174,188 ----
+  
+        REAL tauref(ngrid), tau(ngrid,naerkind)
+        REAL aerosol(ngrid,nlayer,naerkind)
+!       REAL rdust(ngridmx,nlayermx)  ! Dust geometric mean radius (m)
+!       REAL rice(ngridmx,nlayermx)   ! Ice geometric mean radius (m)
+        REAL nuice(ngridmx,nlayermx)  ! Estimated effective variance
+  c
+  c    Local variables :
+  c    -----------------
+  
+!       INTEGER j,l,ig,n,ich
+!       INTEGER aer_count,iaer
+        INTEGER jd,ig0,nd
+  
+        real  cste_mars ! solar constant on Mars (Wm-2)
+***************
+*** 255,260 ****
+--- 259,335 ----
+  
+        IF (firstcall) THEN
+  
++ c        Please name the different scatterers here ----------------
++ c        PLEASE MAKE SURE that you set up the right number of
++ c          scatterers in dimradmars.h (naerkind);
++ c        name_iaer(1) = "dust_conrath"
++          name_iaer(1) = "dust_doubleq"
++ c        name_iaer(2) = "dust_submicron"
++          name_iaer(2) = "h2o_ice"
++ c        ----------------------------------------------------------
++ 
++ c        Assign a number to the different scatterers
++ c        -------------------------------------------
++ 
++          iaer_dust_conrath=0
++          iaer_dust_doubleq=0
++          iaer_dust_submicron=0
++          iaer_h2o_ice=0
++ 
++          aer_count=0
++          if (.NOT.active) then
++            do iaer=1,naerkind
++              if (name_iaer(iaer).eq."dust_conrath") then
++                iaer_dust_conrath = iaer
++                aer_count = aer_count + 1
++              endif
++            enddo
++          endif
++          if (doubleq.AND.active) then
++            do iaer=1,naerkind
++              if (name_iaer(iaer).eq."dust_doubleq") then
++                iaer_dust_doubleq = iaer
++                aer_count = aer_count + 1
++              endif
++            enddo
++          endif
++          if (submicron.AND.active) then
++            do iaer=1,naerkind
++              if (name_iaer(iaer).eq."dust_submicron") then
++                iaer_dust_submicron = iaer
++                aer_count = aer_count + 1
++              endif
++            enddo
++          endif
++          if (water.AND.activice) then
++            do iaer=1,naerkind
++              if (name_iaer(iaer).eq."h2o_ice") then
++                iaer_h2o_ice = iaer
++                aer_count = aer_count + 1
++              endif
++            enddo
++          endif
++ 
++ c        Check that we identified all tracers:
++          if (aer_count.ne.naerkind) then
++            write(*,*) "callradite: found only ",aer_count," scatterers"
++            write(*,*) "               expected ",naerkind
++            write(*,*) "please make sure that the number of"
++            write(*,*) "scatterers in dimradmars.h, the names"
++            write(*,*) "in callradite.F, and the flags in"
++            write(*,*) "callphys.def are all consistent!"
++            do iaer=1,naerkind
++              write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
++            enddo
++            stop
++          else
++            write(*,*) "callradite: found all scatterers, namely:"
++            do iaer=1,naerkind
++              write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
++            enddo
++          endif
++ c        -------------------------------------------
++ 
+           DO ig=1,ngrid
+              pview(ig)=1.66     ! cosecant of viewing angle
+           ENDDO
+***************
+*** 299,307 ****
+  
+  c     Updating aerosol size distributions:
+        CALL updatereffrad(ngrid,nlayer,
+!      &                pplev,pplay,
+!      &                rice,nuice,
+!      &                reffrad,nueffrad)
+  
+  c     Computing 3D scattering parameters:
+        CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+--- 374,382 ----
+  
+  c     Updating aerosol size distributions:
+        CALL updatereffrad(ngrid,nlayer,
+!      &                rdust,rice,nuice,
+!      &                reffrad,nueffrad,
+!      &                pq)
+  
+  c     Computing 3D scattering parameters:
+        CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+***************
+*** 311,318 ****
+       &                      omegaREFvis3d,omegaREFir3d)
+  
+  c     Computing aerosol optical depth in each layer:
+!       CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+!      &      tauref,tau,aerosol,reffrad,
+       &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+  
+  c     Starting loop on sub-domain
+--- 386,393 ----
+       &                      omegaREFvis3d,omegaREFir3d)
+  
+  c     Computing aerosol optical depth in each layer:
+!       CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+!      &      pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+       &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+  
+  c     Starting loop on sub-domain
+*** libf/phymars/callkeys.h	Tue Jan 25 15:17:44 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/callkeys.h	Mon Jan 24 11:16:00 2011
+***************
+*** 2,27 ****
+  ! For Fortran 77/Fortran 90 compliance always use line continuation
+  ! symbols '&' in columns 73 and 6
+  !
+!       COMMON/callkeys/callrad,calldifv,calladj,callcond,callsoil,       &
+!      &   season,diurnal,iradia,lwrite,calllott                          &
+!      &   ,iaervar,iddist,topdustref,callstats,calleofdump               &
+!      &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+!      &        calleuv,callmolvis,callmoldiff,thermochem                 &
+!      &   , solarcondate, thermoswater                                   &
+!      &   , semi                                                         &
+!      &   , callemis                                                     &
+!      &   , callg2d                                                      &
+!      &   , linear                                                       &
+!      &   , ilwd                                                         &
+!      &   , ilwb                                                         &
+!      &   , ilwn                                                         &
+!      &   , ncouche                                                      &
+!      &   , alphan                                                       &
+!      &   , rayleigh                                                     &
+!      &   , tracer                                                       &
+!      &   , dustbin,active,doubleq,lifting,callddevil,scavenging         &
+!      &   , sedimentation,activice,water,caps                            &
+!      &   , photochem,nqchem_min                                         
+  
+        LOGICAL callrad,calldifv,calladj,callcond,callsoil,               &
+       &   season,diurnal,lwrite,calllott                                 &
+--- 2,22 ----
+  ! 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                                 &
+***************
+*** 39,45 ****
+        real alphan
+        real solarcondate
+  
+-       integer ecri_phys 
+        integer iddist
+        integer iaervar
+        integer iradia
+--- 34,39 ----
+***************
+*** 51,59 ****
+        logical rayleigh
+        logical tracer
+        integer dustbin
+!       logical active,doubleq,lifting,callddevil,scavenging
+        logical sedimentation,activice,water,caps
+-       !!! plus besoin de iceparty ??
+        logical photochem
+        integer nqchem_min
+  
+--- 45,52 ----
+        logical rayleigh
+        logical tracer
+        integer dustbin
+!       logical active,doubleq,submicron,lifting,callddevil,scavenging
+        logical sedimentation,activice,water,caps
+        logical photochem
+        integer nqchem_min
+  
+*** libf/phymars/newcondens.F	Tue Jan 25 16:49:10 2011
+--- /u/emlmd/LMDZ.MARS.BETA//libf/phymars/newcondens.F	Mon Feb  1 11:00:26 2010
+***************
+*** 590,622 ****
+               zqm(nlayer+1,iq)= zq(nlayer,iq)
+              enddo
+   
+! CCCC
+! CCCC *** WRF comments
+! CCCC
+! c 
+! cc           Tendencies on T, U, V, Q 
+! cc           """"""""""""""""""""""""
+! c            DO l=1,nlayer
+! c 
+! cc             Tendencies on T
+! c                zdtsig(ig,l) = (1/masse(l)) *
+! c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+! c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+! c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+! c                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+! c
+! cc             Tendencies on U
+! c                pduc(ig,l)   = (1/masse(l)) *
+! c     &        ( zmflux(l)*(zum(l) - zu(l))
+! c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+! c
+! c
+! cc             Tendencies on V
+! c                pdvc(ig,l)   = (1/masse(l)) *
+! c     &        ( zmflux(l)*(zvm(l) - zv(l))
+! c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+! c
+! c            END DO
+  
+  c           Tendencies on Q
+              do iq=1,nqmx
+--- 590,618 ----
+               zqm(nlayer+1,iq)= zq(nlayer,iq)
+              enddo
+    
+! c           Tendencies on T, U, V, Q 
+! c           """"""""""""""""""""""""
+!             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
+*** DONE. I COMPARED SOURCES IN 
+./
+*** WITH SOURCES IN 
+/u/emlmd/LMDZ.MARS.BETA/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/create_make_gcm
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/create_make_gcm	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/create_make_gcm	(revision 46)
@@ -0,0 +1,253 @@
+#!/bin/sh
+#set -xv
+#
+# Ehouarn: added the following feature:
+#          create_make_gcm must be called with list of directories
+#          which contain header (or modules) which should be scanned
+#          by create_make_gcm when checking dependencies.
+#          Example:
+#          create_make_gcm dyn3d grid
+#          means that header/modules will be looked for in directories
+#          ., dyn3d and grid
+#
+machine=`hostname`
+os=`uname`
+gcm=`pwd`
+libf=$gcm/libf
+libo=$gcm/libo
+CRAY=0
+if [ "$machine" = "atlas" -o "$machine" = "etoile" -o "$machine" = "axis" ] ; then
+  CRAY=1
+fi
+XNEC=0
+if [ "$machine" = "rhodes" ] ; then
+  XNEC=1
+fi
+VPP=0
+if [ "$machine" = "nymphea0" ] ; then
+  VPP=1
+fi
+#
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Definitions de Macros pour Make"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo 
+echo "# create_make_gcm arguments: $*"
+echo
+echo "# Repertoires :"
+echo
+echo "GCM     = "$gcm
+if [ "$CRAY" = '0' ] ; then
+   echo "MACHINE = sun4"
+fi
+echo 'LIBF    = $(GCM)/libf'
+if [ "$CRAY" = '0' ] ; then
+#   echo 'LIBO    = $(GCM)/libo/$(MACHINE)'
+   echo 'LIBO    = $(LIBOGCM)/$(MACHINE)'
+else
+   echo 'LIBO    = $(GCM)/libo'
+fi
+#echo 'LOCAL_DIR=$(GCM)'
+#echo $localdir
+echo "LOCAL_DIR=`echo $localdir`"
+echo 'BIBIO    = $(LIBF)/bibio'
+echo 'AERONOMARS    = $(LIBF)/aeronomars'
+echo "FILTRE   = filtre"
+echo "PHYS  = "
+echo 'DYN  = $(DYNTYPE)'
+echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'DIRMAIN= $(DYN)$(DIM)d'
+echo 'RM=rm'
+echo
+echo "OPLINK = "
+echo
+echo '# Les differentes librairies pour l"edition des liens:'
+echo
+if [ "$XNEC" = '1' ] ; then
+  echo 'dyn3d      = $(LIBO)/libsxdyn3d.a $(LIBO)/libsx$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libsxdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libsxdyn1d.a'
+  echo 'L_DYN      = -lsxdyn$(DIM)d'
+  echo 'L_FILTRE   = -lsx$(FILTRE)'
+  echo 'L_PHY = -lsxphy$(PHYS) '
+  echo 'L_BIBIO    = -lsxbibio'
+  echo 'L_AERONOMARS    = -lsxaeronomars'
+  echo 'L_ADJNT    ='
+else
+  echo 'dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+  echo 'dyn2d      = $(LIBO)/libdyn2d.a'
+  echo 'dyn1d      = $(LIBO)/libdyn1d.a'
+  echo 'L_DYN      = -l$(DYN)$(DIM)d'
+  echo 'L_FILTRE   = -l$(FILTRE)'
+  echo 'L_PHY = -lphy$(PHYS) '
+  echo 'L_BIBIO    = -lbibio'
+  echo 'L_AERONOMARS    = -laeronomars'
+  echo 'L_ADJNT    ='
+fi
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Option de compilation FORTRAN"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+   echo 'COMPILE = $(F77) $(OPTIM) $(INCLUDE) -c'
+   echo 'COMPILE90 = $(F90) $(OPTIM90) $(INCLUDE) -c'
+   echo 'COMPTRU90 = $(F90) $(OPTIMTRU90) $(INCLUDE) -c'
+   echo "LINK    = $LINK"
+   echo "AR      = $AR"
+echo
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Creation des differents executables"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo "# Executables:"
+echo "# ------------"
+echo
+echo "PROG = code"
+echo
+echo 'main : $(DYN) bibio phys aeronomars $(OPTION_DEP) '
+echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
+echo '	cd $(LOCAL_DIR); \'
+echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \'
+if [ "$CRAY" = '0' ] ; then
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+else
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+fi
+echo
+echo 'dyn : $(LIBO)/libdyn$(DIM)d.a $(FILTRE)$(DIM)d'
+echo
+echo 'olddyn : $(LIBO)/libolddyn$(DIM)d.a $(FILTRE)$(DIM)d'
+echo
+echo 'phys : $(LIBPHY)'
+echo
+echo 'bibio : $(LIBO)/libbibio.a'
+echo
+echo 'aeronomars : $(LIBO)/libaeronomars.a'
+echo
+echo 'adjnt : $(LIBO)/libadjnt.a'
+echo
+echo '$(FILTRE)3d : $(LIBO)/lib$(FILTRE).a'
+echo
+echo '$(FILTRE)2d :'
+echo
+echo '$(FILTRE)1d :'
+echo
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo "# Contenu des differentes bibliotheques"
+echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
+echo
+echo
+cd $libf >/dev/null 2>&1
+for diri in ` ls `
+do
+   if [ -d $diri ] ; then
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.F90`" != "" ]  ; then 
+      cd $diri >/dev/null 2>&1
+      echo
+      listlib=""
+      for i in `ls *.F`
+      do
+         fili=`basename $i .F`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then 
+            listlib=$listlib" "$fili
+         fi
+      done
+      for i in `ls *.F90`
+      do
+         fili=`basename $i .F90`
+         test=` (  head $i | grep '      PROGRAM' ) `
+         if [ "$test" = "" ] ; then
+            listlib=$listlib" "$fili
+         fi 
+      done
+#
+      echo
+      echo
+      echo "#======================================================================="
+      echo "# Contenu de la bibliotheque correspondant au Directory "$diri
+      echo "#======================================================================="
+      echo
+      for fili in $listlib
+      do
+         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+         echo
+      done
+      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
+      echo
+      echo
+      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
+      echo
+      for fili in $listlib
+      do
+         if [ -f $fili.F90 ] ; then
+           trufile=$fili.F90
+         else
+           trufile=$fili.F
+         fi
+         F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1
+                 egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
+                 egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1
+         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile
+         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+         for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | sed -e 's/,/ /' | awk ' { print $2 } ' ) `
+         do
+            stri=`echo $stri | tr [A-Z] [a-z]`
+            if [ -f $stri ] ; then
+               echo $str1 \\
+               str1='$(LIBF)/'$diri'/'$stri
+            else
+               if [ -f $stri.F ] || [ -f $stri.F90 ] ; then
+                  echo $str1 \\
+                  str1='$(LIBO)/lib'$diri'.a('$stri'.o)'
+               else
+#                  for dirinc in dyn3d grid bibio aeronomars phymars
+                  for dirinc in $*
+                  do
+                     if [ -f ../$dirinc/$stri ] ; then
+                        echo $str1 \\
+                        str1='$(LIBF)/'`cd .. ; ls */$stri | head -1`
+                     fi
+                     if [ -f ../$dirinc/$stri.F90 ] ; then
+                        echo $str1 \\
+                        str1='$(LIBO)/lib'$dirinc'.a('$stri'.o)'
+                     fi
+                  done
+               fi
+            fi
+         done
+         echo $str1
+	 if [ "$F90" -eq '0' ] ; then
+           echo '	cd $(LOCAL_DIR); \'
+	   echo '	$(COMPILE) $(LIBF)/'$diri'/'$trufile' ; \'
+	 else
+           echo '	cd $(LOCAL_DIR); \'
+           if [ -f $fili.F90 ] ; then
+	      echo '	$(COMPTRU90) $(LIBF)/'$diri'/'$trufile' ; \'
+           else
+	      echo '	$(COMPILE90) $(LIBF)/'$diri'/'$trufile' ; \'
+           fi
+           MODU=0; egrep -i '^ *module ' $trufile> /dev/null 2>&1 && MODU=1
+            if [ "$MODU" -eq '1' -a "$CRAY" != '1' ] ; then
+              if [ "$os" = 'UNIX_System_V' ] ; then
+                echo '	cp $(MOD_LOC_DIR)/*.$(MOD_SUFFIX) $(LIBO)/ ; \'
+              else
+                echo '	mv $(MOD_LOC_DIR)/'$fili'.$(MOD_SUFFIX) $(LIBO)/'$fili'.$(MOD_SUFFIX) ; \'
+#                echo '	if [ "$(MOD_LOC_DIR)" ne "$(LIBO)" ] ; then mv $(MOD_LOC_DIR)/'*'.$(MOD_SUFFIX) $(LIBO) ; fi ; \'
+              fi
+            fi
+	 fi
+	 if ( [ "$XNEC" -eq '1' ] || [ "$X6NEC" = '1' ] || [ "$X8BRODIE" = '1' ] ) ; then
+           echo '	sxar r $(LIBO)/libsx'$diri'.a '$fili'.o ; \'
+         fi
+         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
+         echo '	cd $(GCM)'
+	 echo
+      done
+#	 
+      echo
+   cd $libf
+   fi
+   fi
+done
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/callphys.def
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/callphys.def	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/callphys.def	(revision 46)
@@ -0,0 +1,115 @@
+##General options
+##~~~~~~~~~~~~~~~
+#Run with or without tracer transport ?
+tracer=.false.
+
+#Diurnal cycle ?  if diurnal=False, diurnal averaged solar heating
+diurnal=.true.
+
+#Seasonal cycle ? if season=False, Ls stays constant, to value set in "start"
+season = .true.   
+
+#write some more output on the screen ?
+lwrite = .false.    
+
+#Save statistics in file "stats.nc" ?
+stats =.true.
+
+#Save EOF profiles in file "profiles" for Climate Database?
+calleofdump = .false.
+
+## Dust scenario. Used if the dust is prescribed (i.e. if tracer=F or active=F)
+## ~~~~~~~~~~~~~
+#  =1 Dust opt.deph read in startfi; =2 Viking scenario; =3 MGS scenario,
+#  =4 Mars Year 24 from TES assimilation (same as =24 for now)
+#  =24 Mars Year 24 from TES assimilation (ie: MCD reference case)
+#  =25 Mars Year 25 from TES assimilation (ie: a year with a global dust storm)
+#  =26 Mars Year 26 from TES assimilation
+iaervar = 24 
+# Dust opacity at 700 Pa (when constant, i.e. for the iaervar=1 case)
+tauvis=0.2
+# Dust vertical distribution: 
+# (=0: old distrib. (Pollack90), =1: top set by "topdustref",
+#  =2: Viking scenario; =3 MGS scenario)
+iddist  = 3
+# Dust top altitude (km). (Matters only if iddist=1)
+topdustref = 55.
+
+## Physical Parameterizations :
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~
+# call radiative transfer ?
+callrad   = .true.
+# call NLTE radiative schemes ?   matters only if callrad=T
+callnlte = .true.
+# call CO2 NIR absorption ?   matters only if callrad=T
+callnirco2 = .true.
+# call turbulent vertical diffusion ?
+calldifv  = .true.
+# call convective adjustment ?
+calladj  = .true.
+# call CO2 condensation ?
+callcond =.true.
+# call thermal conduction in the soil ?
+callsoil = .true.
+# call Lott's gravity wave/subgrid topography scheme ?
+calllott  = .true.
+
+## Radiative transfer options :
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~
+# the rad.transfer is computed every "iradia" physical timestep
+iradia    = 1
+# Output of the exchange coefficient mattrix ? for diagnostic only
+callg2d  = .false.
+# Rayleigh scattering : (should be .false. for now)
+rayleigh  = .false.
+
+## Tracer (dust water, ice and/or chemical species) options (used if tracer=T):
+## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# DUST: Transported dust ? (if >0, use 'dustbin' dust bins)
+dustbin    = 0
+# DUST: Radiatively active dust ? (matters if dustbin>0)
+active  = .false.
+# DUST: use mass and number mixing ratios to predict dust size ?
+# (must also have dustbin=1)
+doubleq   = .false.
+# DUST: lifted by GCM surface winds ?
+lifting = .false.
+# DUST: lifted by dust devils ?
+callddevil = .false.
+# DUST: Scavenging by CO2 snowfall ?
+scavenging = .false.
+# DUST/WATERICE: Gravitationnal sedimentation ?
+sedimentation = .false.
+# WATERICE: Radiatively active transported atmospheric water ice ?
+activice   = .false.
+# WATER: Compute water cycle
+water = .false.
+# WATER: current permanent caps at both poles. True IS RECOMMENDED
+#        (with .true., North cap is a source of water and South pole
+#         is a cold trap)
+caps  = .true.
+# PHOTOCHEMISTRY: include chemical species 
+photochem  = .false.
+
+## Thermospheric options (relevant if tracer=T) :
+##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# call thermosphere ?
+callthermos = .false.
+# WATER: included without cycle (only if water=.false.)
+thermoswater = .false.
+# call thermal conduction ? (only if callthermos=.true.)
+callconduct = .false.
+# call EUV heating ? (only if callthermos=.true.)
+calleuv=.false.
+# call molecular viscosity ? (only if callthermos=.true.)
+callmolvis = .false.
+# call molecular diffusion ? (only if callthermos=.true.)
+callmoldiff = .false.
+# call thermospheric photochemistry ? (only if callthermos=.true.)
+thermochem = .false.
+# date for solar flux calculation: (1985 < date < 2002)
+## (Solar min=1996.4 ave=1993.4 max=1990.6)
+solarcondate = 1993.4
+       
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.1d
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.1d	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.1d	(revision 46)
@@ -0,0 +1,64 @@
+#
+#----------------------------------------------------------------------- 
+# Run parameters for the 1D 'testphys1d.e' model                                          
+#-----------------------------------------------------------------------                                         
+
+#### Time integration parameters
+#
+# Initial date (in martian sols ; =0 at Ls=0)
+day0=0
+# Initial local time (in hours, between 0 and 24)
+time=0
+# Number of time steps per sol
+day_step=48
+# Number of sols to run 
+ndt = 100
+
+#### Physical parameters
+#
+# Surface pressure (Pa)
+psurf= 610
+# Reference dust opacity at 700 Pa, in the visible (true tau~tauref*psurf/700)
+tauvis=0.2
+# latitude (in degrees)
+latitude= 0.
+# Albedo of bare ground
+albedo=0.2
+# Soil thermal inertia (SI)
+inertia=400
+# zonal eastward component of the geostrophic wind (m/s)
+u=10.
+# meridional northward component of the geostrophic wind (m/s)
+v=0.
+# Initial CO2 ice on the surface (kg.m-2)
+co2ice=0
+# hybrid vertical coordinate ? (.true. for hybrid and .false. for sigma levels)
+hybrid=.true.
+
+
+###### Initial atmospheric temperature profile
+#
+# Type of initial temperature profile
+#         ichoice=1   Constant Temperature:  T=tref
+#         ichoice=2   Savidjari profile (as Seiff but with dT/dz=cte)
+#         ichoice=3   Lindner (polar profile)
+#         ichoice=4   inversion
+#         ichoice=5   Seiff  (standard profile, based on Viking entry)
+#         ichoice=6   constant T  +  gaussian perturbation (levels)
+#         ichoice=7   constant T  + gaussian perturbation (km)
+#         ichoice=8   Read in an ascii file "profile" 
+ichoice=5
+# Reference temperature tref (K)
+tref=200
+# Add a perturbation to profile if isin=1
+isin=0
+# peak of gaussian perturbation (for ichoice=6 or 7)
+pic=26.522
+# width of the gaussian perturbation (for ichoice=6 or 7)
+largeur=10
+# height of the gaussian perturbation (for ichoice=6 or 7)
+hauteur=30.
+
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x25
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x25	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x25	(revision 46)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 480
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=9000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=9000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=10
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=120
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 90
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x32
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x32	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.32x24x32	(revision 46)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 480
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=9000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=9000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=10
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=120
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 130
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x25
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x25	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x25	(revision 46)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=5
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 4000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=5000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=5000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 90
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x32
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x32	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x32	(revision 46)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=5
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 4000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=5000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=5000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 130
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 50000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x50
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x50	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run.def.64x48x50	(revision 46)
@@ -0,0 +1,112 @@
+#
+#----------------------------------------------------------------------- 
+#Parametres de controle du run:                                          
+#------------------------------                                          
+
+# Nombre de jours d'integration                                         
+     nday=9999
+
+# nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
+ day_step = 960
+
+# periode pour le pas Matsuno (en pas)                                  
+  iperiod=5
+
+# periode de sortie des variables de controle (en pas)                  
+  iconser=120
+
+# periode d'ecriture du fichier histoire (en jour)                      
+    iecri=100
+
+# periode de stockage fichier histmoy (en jour)                         
+ periodav=60.
+
+# periode de la dissipation (en pas)                                    
+  idissip=1
+
+# choix de l'operateur de dissipation (star ou  non star )              
+ lstardis=.true.
+
+# avec ou sans coordonnee hybrides
+ hybrid=.true.
+
+# nombre d'iterations de l'operateur de dissipation   gradiv            
+nitergdiv=1
+
+# nombre d'iterations de l'operateur de dissipation  nxgradrot          
+nitergrot=2
+
+# nombre d'iterations de l'operateur de dissipation  divgrad            
+   niterh=2
+
+# temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
+ tetagdiv= 3000.
+
+# temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
+ tetagrot=20000.
+
+# temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
+ tetatemp=20000.
+
+# coefficient pour gamdissip                                            
+  coefdis=0.
+
+# choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+  purmats=.false.
+
+# avec ou sans physique                                                 
+   physic=.true.
+
+# periode de la physique (en pas)                                       
+  iphysiq=20
+
+# choix d'une grille reguliere                                          
+  grireg=.true.
+
+# frequence (en pas) de l'ecriture du fichier diagfi               
+ ecritphy=240
+
+# longitude en degres du centre du zoom                                 
+   clon=63.
+
+# latitude en degres du centre du zoom                                  
+   clat=0.
+
+# facteur de grossissement du zoom,selon longitude                      
+  grossismx=1.
+
+# facteur de grossissement du zoom ,selon latitude                      
+ grossismy=1.
+
+#  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
+  fxyhypb=.false.
+
+# extension en longitude  de la zone du zoom  ( fraction de la zone totale)
+   dzoomx= 0.
+
+# extension en latitude de la zone  du zoom  ( fraction de la zone totale)
+   dzoomy=0.
+
+#  raideur du zoom en  X
+    taux=2.
+
+#  raideur du zoom en  Y
+    tauy=2.
+
+#  Fonction  f(y) avec y = Sin(latit.) si = .TRUE. ,  Sinon  y = latit.
+  ysinus= .false.
+
+# Avec sponge layer
+  callsponge  = .true.
+ 
+# Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), mode2(u=umoy,v=vmoy)
+  mode_sponge= 2
+
+# Sponge:  hauteur de sponge (km)
+  hsponge= 230
+
+# Sponge:  tetasponge (secondes)
+  tetasponge = 30000
+
+# some definitions for the physics, in file 'callphys.def'
+INCLUDEDEF=callphys.def
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run0
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run0	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run0	(revision 46)
@@ -0,0 +1,101 @@
+#!/bin/csh
+###########################################################################
+# Script to perform several chained LMD Mars GCM simulations
+# SET HERE the maximum total number of simulations
+
+set nummax=1
+
+###########################################################################
+
+
+echo "---------------------------------------------------------"
+echo "starting run0"
+
+set dir=`pwd`
+set machine=`hostname`
+set address=`whoami`
+
+# Look for file "num_run" which should contain 
+# the value of the previously computed season
+# (defaults to 0 if file "num_run" does not exist)
+if ( -f num_run ) then
+ echo "found file num_run"
+  set numold=`cat num_run`
+else
+  set numold=0
+endif
+echo "numold is set to" ${numold}
+
+
+# Set value of current season 
+set numnew=${numold}
+@ numnew = ${numnew} + 1
+echo "numnew is set to" ${numnew}
+
+# Look for initialization data files (exit if none found)
+if ( ( -f start${numold}.nc ) && ( -f startfi${numold}.nc ) ) then
+   \cp -f start${numold}.nc start.nc
+   \cp -f startfi${numold}.nc startfi.nc
+else if ( ${numold} == 99999 ) then
+    echo "No run because previous run crashed ! (99999 in num_run)"
+    exit
+else
+   echo "Where is file start"${numold}".nc??"
+   exit
+endif
+
+
+# Run GCM
+nice gcm.e >! lrun${numnew} 
+
+
+# Check if run ended normaly and copy datafiles
+if ( ( -f restartfi.nc ) && ( -f restart.nc ) ) then
+  echo "Run seems to have ended normaly"
+  \mv -f restartfi.nc startfi${numnew}.nc
+  \mv -f restart.nc start${numnew}.nc
+else
+  if ( -f num_run ) then
+    \mv -f num_run num_run.crash
+  else
+    echo "No file num_run to build num_run.crash from !!"
+    # Impose a default value of 0 for num_run
+    echo 0 >! num_run.crash
+  endif
+ echo 99999 >! num_run
+############## To receive an Email message if the run crashes ########
+mail -s "crash run GCM" $address <<ENDMAIL
+The run on $machine in $dir has just crashed.
+ENDMAIL
+############################################"" 
+ exit
+endif
+
+# Copy other datafiles that may have been generated
+if ( -f diagfi.nc ) then
+  \mv -f diagfi.nc diagfi${numnew}.nc
+endif
+if ( -f diagsoil.nc ) then
+  \mv -f diagsoil.nc diagsoil${numnew}.nc
+endif
+if ( -f stats.nc ) then
+  \mv -f stats.nc stats${numnew}.nc
+endif
+if ( -f profiles.dat ) then
+  \mv -f profiles.dat profiles${numnew}.dat
+  \mv -f profiles.hdr profiles${numnew}.hdr
+endif
+
+# Prepare things for upcoming runs by writing
+# value of computed season in file num_run
+echo ${numnew} >! num_run
+
+# If we are over nummax : stop
+if ( `expr $numnew + 1 \> $nummax ` == 1) then
+   exit
+else
+   \cp -f run0 exe_mars
+   exe_mars
+endif 
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_farm
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_farm	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_farm	(revision 46)
@@ -0,0 +1,28 @@
+# Script to submit simulations with the LMD MARS GCM on 
+# a farm of computers using the run manager named "Torque".
+# To run it, just type 
+# > qsub run_farm
+
+# Shell
+#PBS -S /bin/bash
+# Job Name
+#PBS -N run_mars
+# Merge output and error logs
+#PBS -j oe
+
+####################################
+# SELECT HERE THE RUN DURATION CLASS :
+# Queue std(6h) / day / week /infini
+
+#PBS -q std
+
+# Go to present working directory
+cd  $PBS_O_WORKDIR
+
+# SELECT HERE THE TYPE OF SCRIPT TO USE : "run0" OR "run_mcd"
+
+run0
+
+####################################
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_mcd
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_mcd	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/run_mcd	(revision 46)
@@ -0,0 +1,78 @@
+#!/bin/csh
+##############################################################################
+# Script to run successive monthly (a month spans 30 deg. in Ls)
+# simulations of the LMD Mars GCM.
+# This script uses the following files:
+# - "run0": script to compute a given month
+# - "num_run": single line file containing a value, which is the value of
+#   the 'initializing' month
+# - "run.def.ref": a "run.def" file, exept that variable "nday" is set to 9999
+# - all files usually neaded to run the GCM. Note that initialization
+#   datafiles "start.nc" and "startfi.nc" must be
+#   "start${num_run}.nc" and "startfi${num_run}.nc"
+##############################################################################
+# DON'T FORGET TO:
+# 1) Set the "number of simulation" to 1 in "run0"
+# 2) Copy "run.def" to "run.def.ref" and SET nday to 9999 in run.def.ref
+# 3) uncomment the various lines below (those which begin with "sed ...")
+# 4) If restarting in the middle of a year: 
+#       -Below, Comment all the month already computed
+#       -Write  "N" in file "num_run" if starting from startN.nc !
+##############################################################################
+
+
+# Remove old "error" file (if any) and create a brand new (blank) one
+\rm -f  error; touch error
+
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+  sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #1
+  sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #2
+  sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #3
+  sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #4
+  sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #5
+  sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #6
+  sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #7
+  sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #8
+  sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #9
+  sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #10
+  sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #11 
+  sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #12
+#
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+# sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #13
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #14
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #15
+# sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #16
+# sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #17
+# sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #18
+# sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #19
+# sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #20
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #21
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #22
+# sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #23
+# sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #24
+#
+# 12 martian months (=30°deg Ls) of unequal length (excentric orbit)
+# sed s/9999/61/ run.def.ref >! run.def ; run0 >>& error     #25
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #26
+# sed s/9999/66/ run.def.ref >! run.def ; run0 >>& error     #27
+# sed s/9999/65/ run.def.ref >! run.def ; run0 >>& error     #28
+# sed s/9999/60/ run.def.ref >! run.def ; run0 >>& error     #29
+# sed s/9999/54/ run.def.ref >! run.def ; run0 >>& error     #30
+# sed s/9999/50/ run.def.ref >! run.def ; run0 >>& error     #31
+# sed s/9999/46/ run.def.ref >! run.def ; run0 >>& error     #32
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #33
+# sed s/9999/47/ run.def.ref >! run.def ; run0 >>& error     #34
+# sed s/9999/51/ run.def.ref >! run.def ; run0 >>& error     #35
+# sed s/9999/56/ run.def.ref >! run.def ; run0 >>& error     #36
+
+# These last lines allow to reconstruct the last num_run after a model crash 
+# (because after crash, num_run was set to 9999 so that no further simulation
+# Could be performed
+   set number=`cat num_run`
+   if ( $number == 99999) then
+      set numold=`cat num_run.crash`
+      echo '-----' >>& error
+      echo 'Seasonal simulation aborted after starting from start'$numold >>& error
+      \mv -f num_run.crash num_run  
+   endif
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.chemistry
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.chemistry	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.chemistry	(revision 46)
@@ -0,0 +1,16 @@
+15
+co2
+co
+o
+o1d
+o2
+o3
+h
+h2
+oh
+ho2
+h2o2
+n2
+ar
+h2o_ice
+h2o_vap
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.co2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.co2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.co2	(revision 46)
@@ -0,0 +1,2 @@
+1
+co2
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.watercycle
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.watercycle	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/traceur.def.watercycle	(revision 46)
@@ -0,0 +1,3 @@
+2
+h2o_ice
+h2o_vap
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/z2sig.def
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/z2sig.def	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/deftank/z2sig.def	(revision 46)
@@ -0,0 +1,68 @@
+10.00000     H: atmospheric scale height (km) (used as a reference only)
+0.0040       Typical pseudo-altitude (m) for 1st layer (z=H*log(sigma))
+0.018       ,, ,,  ,, ,, ,, ,,  ,, ,, ,,  2nd layer, etc...
+0.0400
+0.1000
+0.228200
+0.460400
+0.907000
+1.73630
+3.19040
+5.54010
+8.97780
+13.5138
+18.9666
+25.0626
+31.5527
+38.4369
+45.4369
+52.4369
+59.4369
+66.4369
+73.4369
+80.4369
+87.4369
+94.4369
+101.4369
+108.437
+115.437
+122.437
+129.437
+136.437
+143.437
+150.437
+157.437
+164.437
+171.437
+178.437
+185.437
+192.437
+199.437
+206.437
+213.437
+220.437
+227.437
+234.437
+241.437
+248.437
+255.437
+262.437
+269.437
+276.437
+283.437
+290.437
+297.437
+304.437
+311.437
+318.437
+325.437
+332.437
+339.437
+346.437
+353.437
+360.437
+367.437
+374.437
+381.437
+388.437
+395.437
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/chimiedata.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/chimiedata.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/chimiedata.h	(revision 46)
@@ -0,0 +1,60 @@
+c ------------------------------------
+c ---  Data for chemical routines  ---
+c ------------------------------------
+c    Author: Sebastien Lebonnois
+c            Franck Lefevre
+c    
+c  Update after water clouds included
+c ------------------------------------
+c
+      integer    nd, nozo, nr, nsza, ntemp
+c
+      parameter (nd    = 11)
+      parameter (nozo  = 7)
+      parameter (nr    = nd + 28)
+      parameter (nsza  = 27)
+      parameter (ntemp = 4)
+c
+      real       kb
+      parameter (kb = 1.38e-23)
+c
+c     factor: molecular gas constant/(boltzmann*gravity)
+c
+      real       factor
+      parameter (factor = 192./(kb*1.e4*3.72))
+c
+      common/chimiedata/reactifs,nprod,nperte,prod,perte,jphot,
+     $                  colairtab,table_ozo
+c
+c     used in obsolete scheme A :
+      integer    reactifs(nr,5),nprod(nqmx),nperte(nqmx)
+      integer    prod(nqmx,100),perte(nqmx,100,2)
+c
+c     VERSION: 28/05/2004  (update: Ar)
+c
+c     photodissociation rates matrix: version dependent
+c     for this version, file jmars.20030707
+c
+      real       jphot(ntemp,nsza,0:200,nozo,nd)
+      real       colairtab(0:200)
+      real       szatab(nsza)
+      real       table_ozo(nozo)
+c
+      data       szatab/0.,  5., 10., 15., 20., 25.,
+     $                 30., 35., 40., 45., 50., 55.,
+     $                 60., 65., 70., 75., 80., 82.,
+     $                 84., 86., 88., 90., 91., 92.,
+     $                 93., 94., 95./
+c
+c     compounds taken into account: version dependent
+c     DOES NOT INCLUDE h2o NOR water ice
+c
+      integer       ncomp
+      parameter    (ncomp=13)
+      character*10  nomchem(ncomp)
+      data          nomchem/"co2","co","o","o1d","o2","o3","h","h2",
+     $                   "oh","ho2","h2o2", "n2", "ar"/
+c
+      real  mmolchem(ncomp)
+      data  mmolchem/44.,28.,16.,16.,32.,48.,1.,2.,17.,33.,34.,28.,40./
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/conc.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/conc.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/conc.h	(revision 46)
@@ -0,0 +1,18 @@
+c**********************************************************************
+
+c	conc.h
+	
+c**********************************************************************
+
+      integer ncomptot
+
+      parameter (ncomptot=ncomp+1)
+
+      common/conc/mmean,Akknew,cpnew,rnew
+ 
+      real mmean(ngridmx,nlayermx)
+      real Akknew(ngridmx,nlayermx)
+      real cpnew(ngridmx,nlayermx)
+      real rnew(ngridmx,nlayermx)
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/interpfast.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/interpfast.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/interpfast.F	(revision 46)
@@ -0,0 +1,29 @@
+      subroutine interpfast(escout,p,nlayer,escin,pin,nl,limdown,limup)
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      real limup,limdown
+      integer nl,nlayer,n1,n,nm,np
+      nm=1
+      do 5 n1=1,nlayer
+         if(p(n1) .gt. limup .or. p(n1) .lt. limdown) then
+            escout(n1) = 0.0
+         else
+            do n = nm,nl-1
+               if (p(n1).ge.pin(n).and.p(n1).le.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(nm)-p(n1))/(pin(np)-pin(nm))
+                  wp=1.0 - wm
+                  goto 33
+               endif
+            enddo
+ 33         escout(n1) = escin(np)*wm + escin(nm)*wp
+         endif
+    5 continue
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/calchim.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/calchim.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/calchim.F	(revision 46)
@@ -0,0 +1,563 @@
+      subroutine calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     $                   zzlay,zday,pq,pdq,rice,
+     &                   dqchim,dqschim,dqcloud,dqscloud)
+c
+      implicit none
+c
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c  Prepare the call for the photochemical module, and send back the
+c  tendencies from photochemistry in the chemical species mass mixing ratios
+c
+c   Author:   Sebastien Lebonnois (08/11/2002)
+c   -------
+c    update 12/06/2003 for water ice clouds and compatibility with dust
+c    update 07/2003 for coupling with thermosphere (Monica Angelats-i-Coll)
+c    update 03/05/2005 cosmetic changes (Franck Lefevre)
+c    update sept. 2008 identify tracers by their names (Ehouarn Millour)
+c
+c   Arguments:
+c   ----------
+c
+c  Input:
+c
+c    ptimestep                  timestep (s)
+c    pplay(ngridmx,nlayermx)    Pressure at the middle of the layers (Pa)
+c    pplev(ngridmx,nlayermx+1)  Intermediate pressure levels (Pa)
+c    pt(ngridmx,nlayermx)       Temperature (K)
+c    pdt(ngridmx,nlayermx)      Temperature tendency (K)
+c    dist_sol                   distance of the sun (AU)
+c    mu0(ngridmx)               cos of solar zenith angle (=1 when sun at zenith)
+c    pq(ngridmx,nlayermx,nqmx)  Advected fields, ie chemical species here
+c    pdq(ngridmx,nlayermx,nqmx) Previous tendencies on pq
+c    rice(ngridmx,nlayermx)     Estimated ice crystal radius (m)
+c
+c  Output:
+c
+c    dqchim(ngridmx,nlayermx,nqmx) ! tendencies on pq due to chemistry
+c    dqschim(ngridmx,nqmx)         ! tendencies on qsurf 
+c
+c=======================================================================
+
+c    Declarations :
+c    --------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "conc.h"
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+
+      real    ptimestep
+      real    pplay(ngridmx,nlayermx)    ! pressure at the middle of the layers
+      real    zzlay(ngridmx,nlayermx)    ! pressure at the middle of the layers
+      real    pplev(ngridmx,nlayermx+1)  ! intermediate pressure levels
+      real    pt(ngridmx,nlayermx)       ! temperature
+      real    pdt(ngridmx,nlayermx)      ! temperature tendency
+      real    dist_sol                   ! distance of the sun (AU)
+      real    mu0(ngridmx)       ! cos of solar zenith angle (=1 when sun at zenith)
+      real    pq(ngridmx,nlayermx,nqmx)  ! tracers mass mixing ratio
+      real    pdq(ngridmx,nlayermx,nqmx) ! previous tendencies
+      real    zday                       ! date (time since Ls=0, in martian days)
+      real    rice(ngridmx,nlayermx)     ! Estimated ice crystal radius (m)
+
+c   outputs:
+c   --------
+
+      real dqchim(ngridmx,nlayermx,nqmx) ! tendencies on pq due to chemistry
+      real dqschim(ngridmx,nqmx)         ! tendencies on qsurf 
+      real dqcloud(ngridmx,nlayermx,nqmx)! tendencies on pq due to condensation
+      real dqscloud(ngridmx,nqmx)        ! tendencies on qsurf 
+
+c Local variables :
+c -----------------
+
+      character*20 str20
+      integer  ig,l,i,iq
+      integer  foundswitch, lswitch
+      real zq(ngridmx,nlayermx,nqmx) ! pq+pdq*ptimestep before chemistry
+                                     ! new mole fraction after
+      real colden(ngridmx,nqmx)      ! Column densities (cm-2)
+      real zt(ngridmx,nlayermx)      ! temperature
+c
+c  for each column of atmosphere:
+c
+      real zpress(nlayermx)       !  Pressure (mbar)
+      real zdens(nlayermx)        !  Density  (cm-3)
+      real ztemp(nlayermx)        !  Temperature (K)
+      real zlocal(nlayermx)       !  Altitude (km)
+      real zycol(nlayermx,nqmx)   !  Composition (mole fractions)
+      real szacol                 !  Solar zenith angle
+      real jo3(nlayermx)          !  Photodissociation rate O3->O1D (s-1)
+c
+c for output:
+c
+      real zdens3d(ngridmx,nlayermx) !  Density  (cm-3)
+      real jo3_3d(ngridmx,nlayermx)  !  Photodissociation rate O3->O1D (s-1)
+      real surfice(ngridmx,nlayermx) !  Surface of ice particules (um2/cm3)
+
+      logical output              ! to issue calls to writediagfi and stats
+      parameter (output=.true.)   ! see at end of routine
+
+      logical,save :: firstcall=.true.
+      integer,save :: nbq  ! number of tracers used in the chemistry
+      integer,save :: niq(nqmx) ! array storing the indexes of the tracers
+
+! index of tracers:
+      integer,save :: i_co2=0
+      integer,save :: i_co=0
+      integer,save :: i_o=0
+      integer,save :: i_o1d=0
+      integer,save :: i_o2=0
+      integer,save :: i_o3=0
+      integer,save :: i_h=0
+      integer,save :: i_h2=0
+      integer,save :: i_oh=0
+      integer,save :: i_ho2=0
+      integer,save :: i_h2o2=0
+      integer,save :: i_n2=0
+      integer,save :: i_ar=0
+      integer,save :: i_ice=0 ! water ice
+      integer,save :: i_h2o=0 ! water vapour
+
+c
+c  scheme A: 1 ; scheme B: 2
+c
+      integer,parameter :: scheme=2
+c
+c=======================================================================
+c     initialization of the chemistry (first call only)
+c=======================================================================
+c
+      if (firstcall) then
+c
+         if (photochem) then
+            print*,'calchim: INIT CHEMISTRY'
+            if (scheme  .eq.  1) then
+               print*,'calchim: Scheme A : A METTRE A JOUR !!'
+               stop
+c              call init_chimie_A
+            else
+               print*,'calchim: Scheme B'
+               call init_chimie_B
+            end if
+         end if
+
+         ! find index of chemical tracers to use
+         nbq=0 ! to count number of tracers
+         i_co2=igcm_co2
+         if (i_co2.eq.0) then
+           write(*,*) "calchim: Error; no CO2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_co2
+         endif
+         i_co=igcm_co
+         if (i_co.eq.0) then
+           write(*,*) "calchim: Error; no CO tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_co
+         endif
+         i_o=igcm_o
+         if (i_o.eq.0) then
+           write(*,*) "calchim: Error; no O tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_o
+         endif
+         i_o1d=igcm_o1d
+         if (i_o1d.eq.0) then
+           write(*,*) "calchim: Error; no O1D tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_o1d
+         endif
+         i_o2=igcm_o2
+         if (i_o2.eq.0) then
+           write(*,*) "calchim: Error; no O2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_o2
+         endif
+         i_o3=igcm_o3
+         if (i_o3.eq.0) then
+           write(*,*) "calchim: Error; no O3 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_o3
+         endif
+         i_h=igcm_h
+         if (i_h.eq.0) then
+           write(*,*) "calchim: Error; no H tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_h
+         endif
+         i_h2=igcm_h2
+         if (i_h2.eq.0) then
+           write(*,*) "calchim: Error; no H2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_h2
+         endif
+         i_oh=igcm_oh
+         if (i_oh.eq.0) then
+           write(*,*) "calchim: Error; no OH tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_oh
+         endif
+         i_ho2=igcm_ho2
+         if (i_ho2.eq.0) then
+           write(*,*) "calchim: Error; no HO2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_ho2
+         endif
+         i_h2o2=igcm_h2o2
+         if (i_h2o2.eq.0) then
+           write(*,*) "calchim: Error; no H2O2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_h2o2
+         endif
+         i_n2=igcm_n2
+         if (i_n2.eq.0) then
+           write(*,*) "calchim: Error; no N2 tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_n2
+         endif
+         i_ar=igcm_ar
+         if (i_ar.eq.0) then
+           write(*,*) "calchim: Error; no AR tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_ar
+         endif
+         i_ice=igcm_h2o_ice
+         if (i_ice.eq.0) then
+           write(*,*) "calchim: Error; no water ice tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_ice
+         endif
+         i_h2o=igcm_h2o_vap
+         if (i_h2o.eq.0) then
+           write(*,*) "calchim: Error; no water vapor tracer !!!"
+           stop
+         else
+           nbq=nbq+1
+           niq(nbq)=i_h2o
+         endif
+
+         write(*,*) 'calchim: found nbq=',nbq,' tracers'
+         write(*,*) '         i_co2=',i_co2
+         write(*,*) '         i_co=',i_co
+         write(*,*) '         i_o=',i_o
+         write(*,*) '         i_o1d=',i_o1d
+         write(*,*) '         i_o2=',i_o2
+         write(*,*) '         i_o3=',i_o3
+         write(*,*) '         i_h=',i_h
+         write(*,*) '         i_h2=',i_h2
+         write(*,*) '         i_oh=',i_oh
+         write(*,*) '         i_ho2=',i_ho2
+         write(*,*) '         i_h2o2=',i_h2o2
+         write(*,*) '         i_n2=',i_n2
+         write(*,*) '         i_ar=',i_ar
+         write(*,*) '         i_ice=',i_ice
+         write(*,*) '         i_h2o=',i_h2o
+!         write(*,*) '         niq(:)=',niq
+!         write(*,*) '     nqchem_min,nqmx=',nqchem_min,nqmx
+         
+         firstcall = .false.
+      end if ! if (firstcall)
+
+! Initialize output tendencies to zero (to handle case of tracers which
+! are not used in the chemistry (e.g. dust))
+      dqchim(:,:,:)=0
+      dqschim(:,:)=0
+
+
+c
+c=======================================================================
+c     loop over grid
+c=======================================================================
+c
+      do ig = 1,ngridmx
+c
+c     local updates
+c 
+         foundswitch = 0
+         do l = 1,nlayermx
+            zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
+            do i=1,nbq
+              iq=niq(i) ! get tracer index
+              zq(ig,l,iq) = pq(ig,l,iq) + pdq(ig,l,iq)*ptimestep
+              zycol(l,iq) = zq(ig,l,iq) * mmean(ig,l)/mmol(iq)
+            enddo
+            zpress(l) = pplay(ig,l)/100.
+            ztemp(l)  = zt(ig,l)
+            zdens(l)  = zpress(l)/(kb*1.e4*ztemp(l))
+            zlocal(l) = zzlay(ig,l)/1000.
+c
+c     search for switch index between regions
+c
+            if (photochem .and. thermochem) then
+               if (foundswitch .eq. 0 .and. pplay(ig,l).lt.1.e-3) then
+                  lswitch = l
+                  foundswitch=1
+               end if
+            end if
+            if ( .not. photochem) then
+               lswitch = 22
+            end if
+            if (.not.  thermochem) then
+               lswitch = min(33,nlayermx+1)
+            end if
+c
+c     ice surface area  in microns^2/cm^3
+c
+c     = 4 pi r^2 * [ zq * mugaz/NA / (rhoice*4/3 pi r^3) ] *zdens
+c     = 3/r * [ zq * mugaz/NA / rhoice ] *zdens
+c     with r in microns, rhoice = 0.92e-12 g microns^-3 and zdens in cm^-3
+c
+            if (water) then
+               zycol(l,i_ice) = (3.e-6/rice(ig,l))*zq(ig,l,i_ice)
+     $                           *(mugaz/6.022e23)*zdens(l)/0.92e-12
+c              write(*,*) "rice=",rice(ig,l)," m / zdens=",zdens(l),
+c    $        " cm-3 / icesurf=",zycol(l,nqmx-1)," microns^2/cm^3"
+               surfice(ig,l) = zycol(l,i_ice)
+            end if
+c
+         end do ! of do l=1,nlayermx
+c
+         szacol = acos(mu0(ig))*180./pi
+c
+c=======================================================================
+c     call chemical subroutine
+c=======================================================================
+c
+        if (photochem) then
+           if (scheme .eq. 1) then
+              print*,'Scheme A : A METTRE A JOUR !!'
+c             call photochemist_A(zycol,szacol,ptimestep,
+c    $                            zpress,ztemp,zdens,dist_sol)
+           else
+              call photochemist_B(lswitch,zycol,szacol,ptimestep,
+     $                            zpress,ztemp,zdens,dist_sol,jo3)
+           end if
+        end if
+
+        if (thermochem) then
+           call chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,
+     $                      zlocal,szacol,ptimestep,zday)
+        end if
+c
+c=======================================================================
+c     tendencies
+c=======================================================================
+c
+c     must be 0. for water ice:
+c
+         if (water) then
+            do l = 1,nlayermx
+!               dqchim(ig,l,nqmx-1) = 0.
+               dqchim(ig,l,i_ice) = 0.
+            end do
+         end if
+c
+c     tendency for CO2 = - sum of others for lower atmosphere
+c     tendency for O   = - sum of others for upper atmosphere
+c
+         do l = 1,nlayermx
+            if (l .lt. lswitch) then
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                  if ((iq.ne.i_co2).and.(iq.ne.i_ice)) then
+                     dqchim(ig,l,iq) = (zycol(l,iq)*mmol(iq)/mmean(ig,l)
+     $                                - zq(ig,l,iq))/ptimestep
+                  else if (iq.eq.i_co2) then
+                     dqchim(ig,l,iq) = 0.
+                  end if
+                  dqschim(ig,iq) = 0.
+               end do ! of do i=1,nbq
+               
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                  if (iq.ne.i_co2) then
+                     dqchim(ig,l,i_co2) = dqchim(ig,l,i_co2) 
+     $                                  - dqchim(ig,l,iq)
+                  end if
+               end do
+             else if (l .ge. lswitch) then
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                   if ((iq.ne.i_o).and.(iq.ne.i_ice)) then
+                      dqchim(ig,l,iq) = (zycol(l,iq)*mmol(iq)
+     $                                  /mmean(ig,l)
+     $                                 - zq(ig,l,iq))/ptimestep
+                   else if (iq.eq.i_o) then
+!                      i_o = iq
+                      dqchim(ig,l,iq) = 0.
+                   end if
+               enddo
+               
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                   if (iq.ne.i_o) then
+                      dqchim(ig,l,i_o) = dqchim(ig,l,i_o) 
+     $                                 - dqchim(ig,l,iq)
+                   end if
+               end do
+             end if ! of if (l.lt.lswitch) else if (l.ge.lswitch)
+          end do ! of do l = 1,nlayermx
+c
+c     dust: This is now taken care of as a first step at beginning of routine
+c
+!          if (nqchem_min .gt. 1) then
+!             do iq = 1,nqchem_min-1
+!                do l = 1,nlayermx
+!                   dqchim(ig,l,iq) = 0.
+!                end do
+!                dqschim(ig,iq) = 0.
+!             end do
+!          end if
+c
+c     condensation of h2o2
+c
+          call perosat(ig,ptimestep,pplev,pplay,
+     $                 ztemp,zycol,dqcloud,dqscloud)
+c
+c     for outputs
+c
+          do i=1,nbq
+            iq=niq(i) ! get tracer index
+             colden(ig,iq) = 0.
+             do l = 1,nlayermx
+c
+c     column density converted in cm-2
+c     pplev en pa, mugaz en g.mol-1 et g en m.s-2
+c     not for ice
+c
+                if (iq.ne.i_h2o2) then
+                  colden(ig,iq) = colden(ig,iq) + zycol(l,iq)
+     $                         *6.022e22*(pplev(ig,l)-pplev(ig,l+1))
+     $                         /(mmean(ig,l)*g)
+                else   ! for H2O2, remove condensation from zycol
+                  colden(ig,iq) = colden(ig,iq) + (zycol(l,iq) +
+     $               dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))
+     $                         *6.022e22*(pplev(ig,l)-pplev(ig,l+1))
+     $                         /(mmean(ig,l)*g)
+                end if
+c
+c     local densities, for outputs (put in zq)
+c     not for ice
+c
+                zq(ig,l,iq) = zycol(l,iq)*zdens(l)
+c                        for H2O2, remove condensation from zycol
+                if (iq.eq.i_h2o2) then
+                   zq(ig,l,iq) = zdens(l)*(zycol(l,iq) +
+     $               dqcloud(ig,l,iq)*ptimestep*mmean(ig,l)/mmol(iq))
+                end if
+             end do
+          end do
+c
+c     density and j(o3->o1d), for outputs
+c
+          zdens3d(ig,1) = zdens(1)
+          jo3_3d(ig,1) = jo3(1)
+          do l = 2,nlayermx
+             zdens3d(ig,l) = zdens(l)
+             jo3_3d(ig,l) = jo3(l)
+          end do
+c
+c=======================================================================
+c     end of loop over grid
+c=======================================================================
+c
+      end do ! of do ig=1,ngridmx
+c
+c=======================================================================
+c     write outputs
+c=======================================================================
+c
+! value of parameter 'output' to trigger writting of outputs
+! is set above at the declaration of the variable.
+
+      if (output) then
+
+         if (ngridmx .gt. 1) then
+c           call writediagfi(ngridmx,'dens','atm dens.','cm-3',3,zdens3d(1,1))
+c           call writediagfi(ngridmx,'jo3','j o3->o1d','s-1',3,jo3_3d(1,1))
+c           call writediagfi(ngridmx,'sice','ice surf.','um2/cm3',3,surfice(1,1))
+            do i=1,nbq
+              iq=niq(i) ! get tracer index
+               if (iq.ne.i_ice) then
+                 write(str20(1:20),'(a20)') noms(iq)
+                 call writediagfi(ngridmx,'n_'//trim(str20),'density',
+     $                             'cm-3',3,zq(1,1,iq))
+c                 call writediagfi(ngridmx,'dqch_'//str5,'density','cm-3',3,dqchim(1,1,iq))
+c                 if (noms(iq) .eq. "h2o2" .or. noms(iq) .eq. "h2o") then
+c                    call writediagfi(ngridmx,'cl_'//str5,'density','cm-3',3,dqcloud(1,1,iq))
+c                 end if
+                 call writediagfi(ngridmx,'c_'//trim(str20),
+     $                            'col. dens.','cm-2',2,colden(1,iq))
+               end if
+            end do
+c
+            if (callstats) then
+c
+c              convert to mole.cm-2 for the column densities
+c
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                  do ig = 1,ngridmx
+                     colden(ig,iq) = colden(ig,iq)/6.022e23
+                  end do   
+               end do 
+c
+c              call wstats(ngridmx,"jo3","jo3->o1d","s-1",3,jo3_3d)
+c
+               do i=1,nbq
+                 iq=niq(i) ! get tracer index
+                  if (iq.ne.i_ice) then
+                     write(str20(1:20),'(a20)') noms(iq)
+                     call wstats(ngridmx,"n_"//trim(str20),"density",
+     &                           "cm-3",3,zq(1,1,iq))
+                     call wstats(ngridmx,"c_"//trim(str20),"col. dens.",
+     &                           "mol cm-2",2,colden(1,iq))
+                  end if
+               end do ! of i=1,nbq
+            end if ! of if (callstats)
+         end if ! of if (ngridmx.gt.1)
+c
+      endif ! of if (output)
+c
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/ch.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/ch.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/ch.F	(revision 46)
@@ -0,0 +1,550 @@
+c 	************************************************************
+c
+c		chapman function for grazing incidence
+c
+c 	************************************************************
+
+	function ch(x,z) 
+
+	integer ierr
+	real ch,x
+
+	double precision ch1,sublim,z,error,aerr,rerr
+	double precision dcadre,fch
+	external fch,dcadre 
+
+	common/integ/ax,az
+	double precision ax,az 
+
+c
+
+	ax=x
+	az=z
+
+	aerr= 0.0d0
+	rerr= 0.0001d0 
+	sublim = 1.0d-4
+	ch1 = dcadre( fch, sublim, az, aerr, rerr, error, ierr )
+	ch = ax * sin(az) * ch1
+
+	return
+	end
+
+c 	************************************************************
+c
+c		integrand for the chapman function 
+c
+c 	************************************************************
+
+	double precision function fch(gi)
+
+	double precision gi
+
+	common/integ/x,z
+	double precision x,z 
+
+!	real x,z,a
+
+	fch = (1./sin(gi))**2. * exp( x *(1.- sin(z)/sin(gi)) )
+
+	return 
+	end
+
+
+
+
+******************************************************************************
+
+      double precision function dcadre (f,a,b,aerr,rerr,error,ier)              
+c                                  specifications for arguments                 
+      integer            ier                                                    
+      double precision   f,a,b,aerr,rerr,error                                  
+c                                  specifications for local variables           
+      integer            ibegs(30),maxts,maxtbl,mxstge,ibeg,ii,nnleft           
+      integer            i,n2,iii,istep2,iend,istep,l,lm1,it,istage,n           
+      double precision   t(10,10),r(10),ait(10),dif(10),rn(4),ts(2049)          
+      double precision   begin(30),finis(30),est(30)                            
+      double precision   h2tol,aittol,length,jumptl,zero,p1,half,one            
+      double precision   two,four,fourp5,ten,hun,cadre,aitlow                   
+      double precision   stepmn,stepnm,stage,curest,fnsize,hrerr                
+      double precision   prever,beg,fbeg,edn,fend,step,astep,tabs,hovn          
+      double precision   fn,sum,sumabs,vint,tabtlm,ergl,ergoal                  
+      double precision   erra,errr,fextrp,errer,diff,sing,fextm1                
+      double precision   h2next,singnx,slope,fbeg2,erret,h2tfex,fi              
+      logical            h2conv,aitken,right,reglar,reglsv(30)                  
+      data               aitlow,h2tol,aittol,jumptl,maxts,maxtbl,mxstge         
+     1                   /1.1d0,.15d0,.1d0,.01d0,2049,10,30/                    
+      data               rn(1),rn(2),rn(3),rn(4)/                               
+     1                   .7142005d0,.3466282d0,.843751d0,.1263305d0/            
+      data               zero,p1,half,one,two,four,fourp5,ten,hun               
+     1                   /0.0d0,0.1d0,0.5d0,1.0d0,2.0d0,4.0d0,                  
+     2                   4.5d0,10.0d0,100.0d0/                                  
+c                                  first executable statement                   
+      ier = 0                                                                   
+      cadre = zero                                                              
+      error = zero                                                              
+      curest = zero                                                             
+      vint = zero                                                               
+      length = dabs(b-a)
+
+      if (length .eq. zero) go to 215                                           
+      if (rerr .gt. p1 .or. rerr .lt. zero) go to 210                           
+      hrerr = rerr+hun                                                          
+      if (aerr .eq. zero .and. hrerr .le. hun) go to 210                        
+      errr = rerr                                                               
+      erra = dabs(aerr)                                                         
+      stepmn = length/(two**mxstge)                                             
+      stepnm = dmax1(length,dabs(a),dabs(b))*ten                                
+      stage = half                                                              
+      istage = 1                                                                
+      fnsize = zero                                                             
+      prever = zero                                                             
+      reglar = .false.                                                          
+c                                  the given interval of integration            
+c                                    is the first interval considered.          
+      beg = a                                                                   
+      fbeg = f(beg)*half                                                        
+      ts(1) = fbeg                                                              
+      ibeg = 1                                                                  
+      edn = b                                                                   
+      fend = f(edn)*half                                                        
+      ts(2) = fend                                                              
+      iend = 2                                                                  
+    5 right = .false.                                                           
+c                                  investigation of a particular                
+c                                    subinterval begins at this point.          
+   10 step = edn - beg                                                          
+      astep =  dabs(step)                                                       
+      if (astep .lt. stepmn) go to 205                                          
+      hrerr = stepnm+astep                                                      
+      if (hrerr .eq. stepnm) go to 205                                          
+      t(1,1) = fbeg + fend                                                      
+      tabs = dabs(fbeg) + dabs(fend)                                            
+      l = 1                                                                     
+      n = 1                                                                     
+      h2conv = .false.                                                          
+      aitken = .false.                                                          
+   15 lm1 = l                                                                   
+      l = l + 1                                                                 
+c                                  calculate the next trapezoid sum,            
+c                                    t(l,1), which is based on *n2* + 1         
+c                                    equispaced points. here,                   
+c                                    n2 = n*2 = 2**(l-1).                       
+      n2 = n+n                                                                  
+      fn = n2                                                                   
+      istep = (iend - ibeg)/n                                                   
+      if (istep .gt. 1) go to 25                                                
+      ii = iend                                                                 
+      iend = iend + n                                                           
+      if (iend .gt. maxts) go to 200                                            
+      hovn = step/fn                                                            
+      iii = iend                                                                
+      fi = one                                                                  
+      do 20 i=1,n2,2                                                            
+         ts(iii) = ts(ii)                                                       
+         ts(iii-1) = f(edn - fi * hovn)                                         
+         fi = fi+two                                                            
+         iii = iii-2                                                            
+         ii = ii-1                                                              
+   20 continue                                                                  
+      istep = 2                                                                 
+   25 istep2 = ibeg + istep/2                                                   
+      sum = zero                                                                
+      sumabs = zero                                                             
+      do 30 i=istep2,iend,istep                                                 
+         sum = sum + ts(i)                                                      
+         sumabs = sumabs + dabs(ts(i))                                          
+   30 continue                                                                  
+      t(l,1) = t(l-1,1)*half+sum/fn                                             
+      tabs = tabs*half+sumabs/fn                                                
+      n = n2                                                                    
+c                                  get preliminary value for *vint*             
+c                                    from last trapezoid sum and update         
+c                                    the error requirement *ergoal*             
+c                                    for this subinterval.                      
+      it = 1                                                                    
+      vint = step*t(l,1)                                                        
+      tabtlm = tabs*ten                                                         
+      fnsize = dmax1(fnsize,dabs(t(l,1)))                                       
+      ergl = astep*fnsize*ten                                                   
+      ergoal = stage*dmax1(erra,errr*dabs(curest+vint))                         
+c                                  complete row l and column l of *t*           
+c                                    array.                                     
+      fextrp = one                                                              
+      do 35 i=1,lm1                                                             
+         fextrp = fextrp*four                                                   
+         t(i,l) = t(l,i) - t(l-1,i)                                             
+         t(l,i+1) = t(l,i) + t(i,l)/(fextrp-one)                                
+   35 continue                                                                  
+      errer = astep*dabs(t(1,l))                                                
+c                                  preliminary decision procedure               
+c                                    if l = 2 and t(2,1) = t(1,1),              
+c                                    go to 135 to follow up the                 
+c                                    impression that intergrand is              
+c                                    straight line.                             
+      if (l .gt. 2) go to 40                                                    
+      hrerr = tabs+p1*dabs(t(1,2))                                              
+      if (hrerr .eq. tabs) go to 135                                            
+      go to 15                                                                  
+c                                  caculate next ratios for                     
+c                                    columns 1,...,l-2 of t-table               
+c                                    ratio is set to zero if difference         
+c                                    in last two entries of column is           
+c                                    about zero                                 
+   40 do 45 i=2,lm1                                                             
+         diff = zero                                                            
+         hrerr = tabtlm+dabs(t(i-1,l))                                          
+         if (hrerr .ne. tabtlm) diff = t(i-1,lm1)/t(i-1,l)                      
+         t(i-1,lm1) = diff                                                      
+   45 continue                                                                  
+      if (dabs(four-t(1,lm1)) .le. h2tol) go to 60                              
+      if (t(1,lm1) .eq. zero) go to 55                                          
+      if (dabs(two-dabs(t(1,lm1))) .lt. jumptl) go to 130                       
+      if (l .eq. 3) go to 15                                                    
+      h2conv = .false.                                                          
+      if (dabs((t(1,lm1)-t(1,l-2))/t(1,lm1)) .le. aittol) go to 75              
+   50 if (reglar) go to 55                                                      
+      if (l .eq. 4) go to 15                                                    
+      hrerr = ergl+errer                                                        
+   55 if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
+      go to 145                                                                 
+c                                  cautious romberg extrapolation               
+   60 if (h2conv) go to 65                                                      
+      aitken = .false.                                                          
+      h2conv = .true.                                                           
+   65 fextrp = four                                                             
+   70 it = it + 1                                                               
+      vint = step*t(l,it)                                                       
+      errer = dabs(step/(fextrp-one)*t(it-1,l))                                 
+      if (errer .le. ergoal) go to 160                                          
+      hrerr = ergl+errer                                                        
+      if (hrerr .eq. ergl) go to 160                                            
+      if (it .eq. lm1) go to 125                                                
+      if (t(it,lm1) .eq. zero) go to 70                                         
+      if (t(it,lm1) .le. fextrp) go to 125                                      
+      if (dabs(t(it,lm1)/four-fextrp)/fextrp .lt. aittol)                       
+     1       fextrp = fextrp*four                                               
+      go to 70                                                                  
+c                                  integrand may have x**alpha type             
+c                                    singularity                                
+c                                    resulting in a ratio of *sing*  =          
+c                                    2**(alpha + 1)                             
+   75 if (t(1,lm1) .lt. aitlow) go to 175                                       
+      if (aitken) go to 80                                                      
+      h2conv = .false.                                                          
+      aitken = .true.                                                           
+   80 fextrp = t(l-2,lm1)                                                       
+      if (fextrp .gt. fourp5) go to 65                                          
+      if (fextrp .lt. aitlow) go to 175                                         
+      if (dabs(fextrp-t(l-3,lm1))/t(1,lm1) .gt. h2tol) go to 175                
+      sing = fextrp                                                             
+      fextm1 = one/(fextrp - one)                                               
+      ait(1) = zero                                                             
+      do 85 i=2,l                                                               
+         ait(i) = t(i,1) + (t(i,1)-t(i-1,1))*fextm1                             
+         r(i) = t(1,i-1)                                                        
+         dif(i) = ait(i) - ait(i-1)                                             
+   85 continue                                                                  
+      it = 2                                                                    
+   90 vint = step*ait(l)                                                        
+      errer = errer*fextm1                                                      
+      hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 95                     
+      ier = max0(ier,65)                                                        
+      go to 160                                                                 
+   95 it = it + 1                                                               
+      if (it .eq. lm1) go to 125                                                
+      if (it .gt. 3) go to 100                                                  
+      h2next = four                                                             
+      singnx = sing+sing                                                        
+  100 if (h2next .lt. singnx) go to 105                                         
+      fextrp = singnx                                                           
+      singnx = singnx+singnx                                                    
+      go to 110                                                                 
+  105 fextrp = h2next                                                           
+      h2next = four*h2next                                                      
+  110 do 115 i=it,lm1                                                           
+         r(i+1) = zero                                                          
+         hrerr = tabtlm+dabs(dif(i+1))                                          
+         if (hrerr .ne. tabtlm) r(i+1) = dif(i)/dif(i+1)                        
+  115 continue                                                                  
+      h2tfex = -h2tol*fextrp                                                    
+      if (r(l) - fextrp .lt. h2tfex) go to 125                                  
+      if (r(l-1)-fextrp .lt. h2tfex) go to 125                                  
+      errer = astep*dabs(dif(l))                                                
+      fextm1 = one/(fextrp - one)                                               
+      do 120 i=it,l                                                             
+         ait(i) = ait(i) + dif(i)*fextm1                                        
+         dif(i) = ait(i) - ait(i-1)                                             
+  120 continue                                                                  
+      go to 90                                                                  
+c                                  current trapezoid sum and resulting          
+c                                    extrapolated values did not give           
+c                                    a small enough *errer*.                    
+c                                    note -- having prever .lt. errer           
+c                                    is an almost certain sign of               
+c                                    beginning trouble with in the func-        
+c                                    tion values. hence, a watch for,           
+c                                    and control of, noise should               
+c                                    begin here.                                
+  125 fextrp = dmax1(prever/errer,aitlow)                                       
+      prever = errer                                                            
+      if (l .lt. 5) go to 15                                                    
+      if (l-it .gt. 2 .and. istage .lt. mxstge) go to 170                       
+      erret = errer/(fextrp**(maxtbl-l))                                        
+      hrerr = ergl+erret                                                        
+      if (erret .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
+      go to 15                                                                  
+c                                  integrand has jump (see notes)               
+  130 hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
+c                                  note that  2*fn = 2**l                       
+      diff = dabs(t(1,l))*(fn+fn)                                               
+      go to 160                                                                 
+c                                  integrand is straight line                   
+c                                    test this assumption by comparing          
+c                                    the value of the integrand at              
+c                                    four *randomly chosen* points with         
+c                                    the value of the straight line             
+c                                    interpolating the integrand at the         
+c                                    two end points of the sub-interval.        
+c                                    if test is passed, accept *vint*           
+  135 slope = (fend-fbeg)*two                                                   
+      fbeg2 = fbeg+fbeg                                                         
+      do 140 i=1,4                                                              
+         diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                     
+         hrerr = tabtlm+diff                                                    
+         if(hrerr .ne. tabtlm) go to 155                                        
+  140 continue                                                                  
+      go to 160                                                                 
+c                                  noise may be dominant feature                
+c                                    estimate noise level by comparing          
+c                                    the value of the integrand at              
+c                                    four *randomly chosen* points with         
+c                                    the value of the straight line             
+c                                    interpolating the integrand at the         
+c                                    two endpoints. if small enough,            
+c                                    accept *vint*                              
+  145 slope = (fend-fbeg)*two                                                   
+      fbeg2 = fbeg+fbeg                                                         
+      i = 1                                                                     
+  150 diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                        
+  155 errer = dmax1(errer,astep*diff)                                           
+      hrerr = ergl+errer                                                        
+      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
+      i = i+1                                                                   
+      if (i .le. 4) go to 150                                                   
+      ier = 66                                                                  
+c                                  intergration over current sub-               
+c                                    interval successful                        
+c                                    add *vint* to *dcadre* and *errer*         
+c                                    to *error*, then set up next sub-          
+c                                    interval, if any.                          
+  160 cadre = cadre + vint                                                      
+      error = error + errer                                                     
+      if (right) go to 165                                                      
+      istage = istage - 1                                                       
+      if (istage .eq. 0) go to 220                                              
+      reglar = reglsv(istage)                                                   
+      beg = begin(istage)                                                       
+      edn = finis(istage)                                                       
+      curest = curest - est(istage+1) + vint                                    
+      iend = ibeg - 1                                                           
+      fend = ts(iend)                                                           
+      ibeg = ibegs(istage)                                                      
+      go to 180                                                                 
+  165 curest = curest + vint                                                    
+      stage = stage+stage                                                       
+      iend = ibeg                                                               
+      ibeg = ibegs(istage)                                                      
+      edn = beg                                                                 
+      beg = begin(istage)                                                       
+      fend = fbeg                                                               
+      fbeg = ts(ibeg)                                                           
+      go to 5                                                                   
+c                                  integration over current subinterval         
+c                                    is unsuccessful. mark subinterval          
+c                                    for further subdivision. set up            
+c                                    next subinterval.                          
+  170 reglar = .true.                                                           
+  175 if (istage .eq. mxstge) go to 205                                         
+      if (right) go to 185                                                      
+      reglsv(istage+1) = reglar                                                 
+      begin(istage) = beg                                                       
+      ibegs(istage) = ibeg                                                      
+      stage = stage*half                                                        
+  180 right = .true.                                                            
+      beg = (beg+edn)*half                                                      
+      ibeg = (ibeg+iend)/2                                                      
+      ts(ibeg) = ts(ibeg)*half                                                  
+      fbeg = ts(ibeg)                                                           
+      go to 10                                                                  
+  185 nnleft = ibeg - ibegs(istage)                                             
+      if (iend+nnleft .ge. maxts) go to 200                                     
+      iii = ibegs(istage)                                                       
+      ii = iend                                                                 
+      do 190 i=iii,ibeg                                                         
+         ii = ii + 1                                                            
+         ts(ii) = ts(i)                                                         
+  190 continue                                                                  
+      do 195 i=ibeg,ii                                                          
+         ts(iii) = ts(i)                                                        
+         iii = iii + 1                                                          
+  195 continue                                                                  
+      iend = iend + 1                                                           
+      ibeg = iend - nnleft                                                      
+      fend = fbeg                                                               
+      fbeg = ts(ibeg)                                                           
+      finis(istage) = edn                                                       
+      edn = beg                                                                 
+      beg = begin(istage)                                                       
+      begin(istage) = edn                                                       
+      reglsv(istage) = reglar                                                   
+      istage = istage + 1                                                       
+      reglar = reglsv(istage)                                                   
+      est(istage) = vint                                                        
+      curest = curest + est(istage)                                             
+      go to 5                                                                   
+c                                  failure to handle given integra-             
+c                                    tion problem                               
+  200 ier = 131                                                                 
+      go to 215                                                                 
+  205 ier = 132                                                                 
+      go to 215                                                                 
+  210 ier = 133                                                                 
+  215 cadre = curest + vint                                                     
+  220 dcadre = cadre                                                            
+ 9000 continue                                                                  
+      if (ier .ne. 0) call uertst (ier,6hdcadre)                                
+ 9005 return                                                                    
+      end     
+
+
+******************************************************************************
+
+	subroutine uertst (ier,name)                                              
+c                                  specifications for arguments                 
+      integer            ier                                                    
+      integer            name(2)                                                
+c                                  specifications for local variables           
+      integer            i,ieq,ieqdf,iounit,level,levold,nameq(6),              
+     *                   namset(6),namupk(6),nin,nmtb                           
+      data               namset/1hu,1he,1hr,1hs,1he,1ht/                        
+      data               nameq/6*1h /                                           
+      data               level/4/,ieqdf/0/,ieq/1h=/                             
+c                                  unpack name into namupk                      
+c                                  first executable statement                   
+      call uspkd (name,6,namupk,nmtb)                                           
+c                                  get output unit number                       
+      call ugetio(1,nin,iounit)                                                 
+c                                  check ier                                    
+      if (ier.gt.999) go to 25                                                  
+      if (ier.lt.-32) go to 55                                                  
+      if (ier.le.128) go to 5                                                   
+      if (level.lt.1) go to 30                                                  
+c                                  print terminal message                       
+      if (ieqdf.eq.1) write(iounit,35) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,35) ier,namupk                               
+      go to 30                                                                  
+    5 if (ier.le.64) go to 10                                                   
+      if (level.lt.2) go to 30                                                  
+c                                  print warning with fix message               
+c      if (ieqdf.eq.1) write(iounit,40) ier,nameq,ieq,namupk                     
+c      if (ieqdf.eq.0) write(iounit,40) ier,namupk                               
+      if (ieqdf.eq.1) continue 
+      if (ieqdf.eq.0) continue 
+      go to 30                                                                  
+   10 if (ier.le.32) go to 15                                                   
+c                                  print warning message                        
+      if (level.lt.3) go to 30                                                  
+      if (ieqdf.eq.1) write(iounit,45) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,45) ier,namupk                               
+      go to 30                                                                  
+   15 continue                                                                  
+c                                  check for uerset call                        
+      do 20 i=1,6                                                               
+         if (namupk(i).ne.namset(i)) go to 25                                   
+   20 continue                                                                  
+      levold = level                                                            
+      level = ier                                                               
+      ier = levold                                                              
+      if (level.lt.0) level = 4                                                 
+      if (level.gt.4) level = 4                                                 
+      go to 30                                                                  
+   25 continue                                                                  
+      if (level.lt.4) go to 30                                                  
+c                                  print non-defined message                    
+      if (ieqdf.eq.1) write(iounit,50) ier,nameq,ieq,namupk                     
+      if (ieqdf.eq.0) write(iounit,50) ier,namupk                               
+   30 ieqdf = 0                                                                 
+      return                                                                    
+   35 format(19h *** terminal error,10x,7h(ier = ,i3,                           
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   40 format(27h *** warning with fix error,2x,7h(ier = ,i3,                    
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   45 format(18h *** warning error,11x,7h(ier = ,i3,                            
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+   50 format(20h *** undefined error,9x,7h(ier = ,i5,                           
+     1       20h) from imsl routine ,6a1,a1,6a1)                                
+c                                                                               
+c                                  save p for p = r case                        
+c                                    p is the page namupk                       
+c                                    r is the routine namupk                    
+   55 ieqdf = 1                                                                 
+      do 60 i=1,6                                                               
+   60 nameq(i) = namupk(i)                                                      
+   65 return                                                                    
+      end                          
+
+
+************************************************************************
+
+      subroutine uspkd  (packed,nchars,unpakd,nchmtb)                           
+c                                  specifications for arguments                 
+      integer            nc,nchars,nchmtb                                       
+c                                                                               
+c      integer            unpakd(1),iblank                                       
+      integer            unpakd(nchars),iblank                                       
+      character          packed(1)           ! Modificado el 29-Ago-2001 porque
+!      integer            packed(1)            esto deberia ser CHARACTER, no??
+      data               iblank /1h /                                           
+c                                  initialize nchmtb                            
+      nchmtb = 0                                                                
+c                                  return if nchars is le zero                  
+      if(nchars.le.0) return                                                    
+c                                  set nc=number of chars to be decoded         
+      nc = min0 (129,nchars)                                                   
+!      decode (nc,150,packed) (unpakd(i),i=1,nc)                                
+      read (packed,150) (unpakd(i),i=1,nc)                                
+  150 format (129a1)                                                           
+c                                  check unpakd array and set nchmtb            
+c                                  based on trailing blanks found               
+      do 200 n = 1,nc                                                           
+         nn = nc - n + 1                                                        
+         if(unpakd(nn) .ne. 536870912) go to 210                                
+  200 continue                                                                  
+  210 nchmtb = nn                                                               
+      return                                                                    
+      end            
+
+
+****************************************************************************
+
+      subroutine ugetio(iopt,nin,nout)                                          
+c                                  specifications for arguments                 
+      integer            iopt,nin,nout                                          
+c                                  specifications for local variables           
+      integer            nind,noutd                                             
+      data               nind/5/,noutd/6/                                       
+c                                  first executable statement                   
+      if (iopt.eq.3) go to 10                                                   
+      if (iopt.eq.2) go to 5                                                    
+      if (iopt.ne.1) go to 9005                                                 
+      nin = nind                                                                
+      nout = noutd                                                              
+      go to 9005                                                                
+    5 nind = nin                                                                
+      go to 9005                                                                
+   10 noutd = nout                                                              
+ 9005 return                                                                    
+      end       
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/chemthermos.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/chemthermos.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/chemthermos.F	(revision 46)
@@ -0,0 +1,200 @@
+      SUBROUTINE chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,
+     $                       zlocal,zenit,ptimestep,zday)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing chemical variations in the thermosphere
+c
+c   author:  MAC July 2003
+c   ------
+c   modifications:
+c   -------------
+c     Ehouarn Sept 2008: added handling of tracers by their names
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "conc.h"
+#include"tracer.h"
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER lswitch,ig
+
+      REAL zday,zycol(nlayermx,nqmx)
+      REAL ptimestep
+      real zenit
+      real ztemp(nlayermx)
+      real zdens(nlayermx)
+      real zpress(nlayermx)			! in mbar
+c
+c    Local variables :
+c    -----------------
+      INTEGER nlayer,l,nesptherm,iq
+      parameter (nesptherm = 11)
+      real tmean
+      real aux1(nlayermx),aux2(nlayermx)
+      real zlocal(nlayermx)
+      real rm(nlayermx,nesptherm) 		!number density (cm-3)
+
+      logical,save :: firstcall=.true.
+
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+!      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+!      integer,save :: g_n2=0
+      integer,save :: g_h2o_vap=0
+! Tracer indexes in the thermospheric chemistry:
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_oh=6
+      integer,parameter :: i_ho2=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o1d=11
+
+
+! Initializations at first call
+      if (firstcall) then
+c        call param_read
+        ! get the indexes of the tracers we'll need
+        g_co2=igcm_co2
+        if (g_co2.eq.0) then
+          write(*,*) "chemthermos: Error; no CO2 tracer !!!"
+          stop
+        endif
+        g_co=igcm_co
+        if (g_co.eq.0) then
+          write(*,*) "chemthermos: Error; no CO tracer !!!"
+          stop
+        endif
+        g_o=igcm_o
+        if (g_o.eq.0) then
+          write(*,*) "chemthermos: Error; no O tracer !!!"
+          stop
+        endif
+        g_o1d=igcm_o1d
+        if (g_o1d.eq.0) then
+          write(*,*) "chemthermos: Error; no O1D tracer !!!"
+          stop
+        endif
+        g_o2=igcm_o2
+        if (g_o2.eq.0) then
+          write(*,*) "chemthermos: Error; no O2 tracer !!!"
+          stop
+        endif
+        g_h=igcm_h
+        if (g_h.eq.0) then
+          write(*,*) "chemthermos: Error; no H tracer !!!"
+          stop
+        endif
+        g_h2=igcm_h2
+        if (g_h2.eq.0) then
+          write(*,*) "chemthermos: Error; no H2 tracer !!!"
+          stop
+        endif
+        g_oh=igcm_oh
+        if (g_oh.eq.0) then
+          write(*,*) "chemthermos: Error; no OH tracer !!!"
+          stop
+        endif
+        g_ho2=igcm_ho2
+        if (g_ho2.eq.0) then
+          write(*,*) "chemthermos: Error; no HO2 tracer !!!"
+          stop
+        endif
+        g_h2o2=igcm_h2o2
+        if (g_h2o2.eq.0) then
+          write(*,*) "chemthermos: Error; no H2O2 tracer !!!"
+          stop
+        endif
+        g_h2o_vap=igcm_h2o_vap
+        if (g_h2o_vap.eq.0) then
+          write(*,*) "chemthermos: Error; no water vapor tracer !!!"
+          stop
+        endif
+
+        firstcall= .false.
+      endif ! of if (firstcall)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      nlayer=nlayermx
+c      zlocal(1)=0.00625
+c      do l=2,nlayer
+c        tmean=ztemp(l)
+c        if(ztemp(l).ne.ztemp(l-1))
+c     &    tmean=(ztemp(l)-ztemp(l-1))/log(ztemp(l)/ztemp(l-1))
+c        zlocal(l)= zlocal(l-1)-log(zpress(l)/zpress(l-1))
+c     &                         *Rnew(ig,l-1)*tmean/g/1000.
+c      enddo
+
+      do l=1,nlayer
+        aux1(l)=0.
+        aux2(l)=0.
+        rm(l,i_co2)  = zycol(l,g_co2)    *zdens(l)  
+        rm(l,i_co)   = zycol(l,g_co)     *zdens(l) 
+        rm(l,i_o)    = zycol(l,g_o)      *zdens(l)
+        rm(l,i_o1d)  = zycol(l,g_o1d)    *zdens(l) 
+        rm(l,i_o2)   = zycol(l,g_o2)     *zdens(l)
+        rm(l,i_h)    = zycol(l,g_h)      *zdens(l) 
+        rm(l,i_h2)   = zycol(l,g_h2)     *zdens(l) 
+        rm(l,i_oh)   = zycol(l,g_oh)     *zdens(l) 
+        rm(l,i_ho2)  = zycol(l,g_ho2)    *zdens(l)
+        rm(l,i_h2o2) = zycol(l,g_h2o2)   *zdens(l) 
+        rm(l,i_h2o)  = zycol(l,g_h2o_vap)*zdens(l) 
+      enddo
+         
+      call flujo(solarcondate+zday/365.)
+
+      call jthermcalc
+     $ (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),rm(1,i_h2),rm(1,i_h2o),
+     &  rm(1,i_h2o2),aux1,aux2,ztemp,nlayermx,zlocal,
+     &  solarcondate+zday/365.,zenit)
+
+      call paramfoto(lswitch,zdens,ztemp,ptimestep/3600.,zenit,
+     &             nlayer,rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
+     &             rm(1,i_co),rm(1,i_h),rm(1,i_oh),rm(1,i_ho2),
+     &             rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),rm(1,i_o1d))
+
+      do l=lswitch,nlayer
+        zycol(l,g_co2)     = max(rm(l,i_co2)  / zdens(l) , 1.e-30)
+        zycol(l,g_co)      = max(rm(l,i_co)   / zdens(l) , 1.e-30)
+        zycol(l,g_o2)      = max(rm(l,i_o2)   / zdens(l) , 1.e-30)
+        zycol(l,g_h2)      = max(rm(l,i_h2)   / zdens(l) , 1.e-30)
+        zycol(l,g_h)       = max(rm(l,i_h)    / zdens(l) , 1.e-30)
+        zycol(l,g_oh)      = max(rm(l,i_oh)   / zdens(l) , 1.e-30)
+        zycol(l,g_ho2)     = max(rm(l,i_ho2)  / zdens(l) , 1.e-30)
+        zycol(l,g_h2o_vap) = max(rm(l,i_h2o)  / zdens(l) , 1.e-30)
+        zycol(l,g_h2o2)    = max(rm(l,i_h2o2) / zdens(l) , 1.e-30)
+        zycol(l,g_o1d)     = max(rm(l,i_o1d)  / zdens(l) , 1.e-30)
+        zycol(l,g_o)       = max(rm(l,i_o)    / zdens(l) , 1.e-30)
+       enddo	!nlayer
+
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/column.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/column.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/column.F	(revision 46)
@@ -0,0 +1,153 @@
+c**********************************************************************
+
+      subroutine column
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx,o2colx,
+     $ o3pcolx,h2o2colx)
+
+
+c     nov 2002        fgg           first version
+
+c**********************************************************************
+
+      implicit none
+
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+
+
+c    local parameters and variables
+
+
+
+c     input and output variables
+
+      integer    nz
+      real       co2colx(nz)                 !column density of CO2 (cm^-2)
+      real       o2colx(nz)                  !column density of O2(cm^-2)
+      real       o3pcolx(nz)                 !column density of O(3P)(cm^-2)
+      real       h2o2colx(nz)                !column density of H2O2(cm^-2)
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       jtot(nz)                    !output: heating rate(erg/s)
+      real       tx(nz)                      !temperature profile
+      real       iz(nz+1)                    !height profile
+      real       zenit
+
+c     local variables
+
+      real       xx
+      real       grav(nzmax)
+      real       ntx(nzmax)
+      real       pmmixx(nzmax)
+      real       Hmix(nzmax)
+      real       nint(nzmax)
+      real       co2vmrx(nzmax)
+      real       o2vmrx(nzmax)
+      real       o3pvmrx(nzmax)
+      real       h2vmrx(nzmax)
+      real       h2ovmrx(nzmax)
+      real       h2o2vmrx(nzmax)
+      real       Hco2
+      real       Ho3p
+      real       Ho2
+      real       Hh2o2
+      real       chapm(nzmax)
+
+
+
+c     local variables
+
+      integer    i,j,k,icol,indexint          !indexes
+      real*8     znt
+
+c External functions
+
+       external    ch
+       real        ch
+
+
+c*************************PROGRAM STARTS*******************************
+
+      do i=1,nz
+         xx = ( radio + iz(i) ) * 1.e5
+         ntx(i)=co2x(i)+o2x(i)+o3px(i)+h2x(i)+h2ox(i)+h2o2x(i)
+         co2vmrx(i)=co2x(i)/ntx(i)
+         o2vmrx(i)=o2x(i)/ntx(i)
+         o3pvmrx(i)=o3px(i)/ntx(i)
+         h2vmrx(i)=h2x(i)/ntx(i)
+         h2ovmrx(i)=h2ox(i)/ntx(i)
+         h2o2vmrx(i)=h2o2x(i)/ntx(i)
+         pmmixx(i) = (pmco2*co2x(i)+pmo2*o2x(i) 
+     $                + pmo3p*o3px(i))/ntx(i)
+         grav(i) = gg * masa /(xx**2)
+         Hmix(i) = kboltzman*tx(i)*n_avog / (pmmixx(i)*grav(i))
+         nint(i) = -Hmix(i)*ntx(i)*
+     $   (exp((iz(i)-iz(i+1))*1e5/Hmix(i))-1)
+      end do
+
+      xx = kboltzman * tx(nz) * n_avog / grav(nz)
+      Ho3p = xx / pmo3p 
+      Hco2 = xx / pmco2
+      Ho2  = xx / pmo2
+      Hh2o2 = xx / pmh2o2
+      o3pcolx(nz) = o3px(nz) * Ho3p
+      co2colx(nz) = co2x(nz) * Hco2
+      h2o2colx(nz) = h2o2x(nz) * Hh2o2
+      o2colx(nz) = o2x(nz) * Ho2
+      do i=1,nz-1
+         co2colx(i) = co2colx(nz)
+         o2colx(i) = o2colx(nz)
+         o3pcolx(i) = o3pcolx(nz)
+         h2o2colx(i) = h2o2colx(nz)
+         do j=i,nz-1
+            co2colx(i) = co2colx(i) + nint(j) 
+     $                   * ((co2vmrx(j+1) + co2vmrx(j)) / 2.)
+            o2colx(i) = o2colx(i) + nint(j)
+     $                  * ((o2vmrx(j+1) + o2vmrx(j)) / 2.)
+            o3pcolx(i) = o3pcolx(i) + nint(j)
+     $                   * ((o3pvmrx(j+1) + o3pvmrx(j)) /2.)
+            h2o2colx(i) = h2o2colx(i) +nint(j)
+     $                     * ((h2o2vmrx(j+1) + h2o2vmrx(j)) / 2.)
+         end do
+      end do
+
+      znt=zenit*3.1416/180.
+      if(zenit.gt.80.0) then
+         do i=1,nz
+            chapm(i) =  
+     $           ch( (iz(i)+radio)/(Hmix(i)*1.e-5),znt)
+         enddo
+      end if
+      znt=zenit*3.1416/180.
+      do i=1,nz
+         if(zenit.le.80.0) then
+            co2colx(i)=co2colx(i)/cos(znt)
+            o2colx(i)=o2colx(i)/cos(znt)
+            o3pcolx(i)=o3pcolx(i)/cos(znt)
+            h2o2colx(i)=h2o2colx(i)/cos(znt)
+         else
+            co2colx(i)=co2colx(i)*chapm(i)
+            o2colx(i)=o2colx(i)*chapm(i)
+            o3pcolx(i)=o3pcolx(i)*chapm(i)
+            h2o2colx(i)=h2o2colx(i)*chapm(i)
+         end if
+      end do
+
+
+      return
+
+
+      end
+
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/concentrations.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/concentrations.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/concentrations.F	(revision 46)
@@ -0,0 +1,266 @@
+      SUBROUTINE concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+                                             
+       IMPLICIT NONE
+c=======================================================================
+
+c CALCULATION OF MEAN MOLECULAR MASS, Cp, Akk and R
+c
+c mmean(ngridmx,nlayermx)			amu
+c cpnew(ngridmx,nlayermx)			J/kg/K
+c rnew(ngridmx,nlayermx)			J/kg/K
+c akknew(ngridmx,nlayermx)			coefficient of thermal concduction
+c
+c=======================================================================
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+
+      REAL pplay(ngridmx,nlayermx)
+      REAL pt(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx)
+      real pq(ngridmx,nlayermx,nqmx)
+      REAL pdq(ngridmx,nlayermx,nqmx)
+      REAL ptimestep
+
+c    Local variables :
+c    -----------------
+      INTEGER,SAVE :: ngrid,nlayer,nq
+      INTEGER iq,l,ig,ll,n,k
+      integer,save :: gind(ncomptot)
+      real ni(ncomptot)
+      real nt, ntot
+      real q2(ngridmx,nlayermx,ncomptot)
+      real zt(ngridmx,nlayermx)
+      real q2tot(ngridmx,nlayermx)
+      real,save :: aki(ncomptot)
+      real,save :: cpi(ncomptot)
+
+      logical,save :: firstcall=.true.
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering for the thermal conduction and
+c     specific heat coefficients
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer,parameter :: i_co2  = 1
+      integer,parameter :: i_co   = 2
+      integer,parameter :: i_o    = 3
+      integer,parameter :: i_o1d  = 4
+      integer,parameter :: i_o2   = 5
+      integer,parameter :: i_o3   = 6
+      integer,parameter :: i_h    = 7
+      integer,parameter :: i_h2   = 8
+      integer,parameter :: i_oh   = 9
+      integer,parameter :: i_ho2  = 10
+      integer,parameter :: i_h2o2 = 11
+      integer,parameter :: i_n2   = 12
+      integer,parameter :: i_ar   = 13
+      integer,parameter :: i_h2o  = 14
+
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_ar=0
+      integer,save :: g_h2o_vap=0
+
+! Initializations at first call
+      if (firstcall) then
+        ! identify the indexes of the tracers we'll need
+        g_co2=igcm_co2
+        if (g_co2.eq.0) then
+          write(*,*) "concentrations: Error; no CO2 tracer !!!"
+          stop
+        endif
+        g_co=igcm_co
+        if (g_co.eq.0) then
+          write(*,*) "concentrations: Error; no CO tracer !!!"
+          stop
+        endif
+        g_o=igcm_o
+        if (g_o.eq.0) then
+          write(*,*) "concentrations: Error; no O tracer !!!"
+          stop
+        endif
+        g_o1d=igcm_o1d
+        if (g_o1d.eq.0) then
+          write(*,*) "concentrations: Error; no O1D tracer !!!"
+          stop
+        endif
+        g_o2=igcm_o2
+        if (g_o2.eq.0) then
+          write(*,*) "concentrations: Error; no O2 tracer !!!"
+          stop
+        endif
+        g_o3=igcm_o3
+        if (g_o3.eq.0) then
+          write(*,*) "concentrations: Error; no O3 tracer !!!"
+          stop
+        endif
+        g_h=igcm_h
+        if (g_h.eq.0) then
+          write(*,*) "concentrations: Error; no H tracer !!!"
+          stop
+        endif
+        g_h2=igcm_h2
+        if (g_h2.eq.0) then
+          write(*,*) "concentrations: Error; no H2 tracer !!!"
+          stop
+        endif
+        g_oh=igcm_oh
+        if (g_oh.eq.0) then
+          write(*,*) "concentrations: Error; no OH tracer !!!"
+          stop
+        endif
+        g_ho2=igcm_ho2
+        if (g_ho2.eq.0) then
+          write(*,*) "concentrations: Error; no HO2 tracer !!!"
+          stop
+        endif
+        g_h2o2=igcm_h2o2
+        if (g_h2o2.eq.0) then
+          write(*,*) "concentrations: Error; no H2O2 tracer !!!"
+          stop
+        endif
+        g_n2=igcm_n2
+        if (g_n2.eq.0) then
+          write(*,*) "concentrations: Error; no N2 tracer !!!"
+          stop
+        endif
+        g_ar=igcm_ar
+        if (g_ar.eq.0) then
+          write(*,*) "concentrations: Error; no AR tracer !!!"
+          stop
+        endif
+        g_h2o_vap=igcm_h2o_vap
+        if (g_h2o_vap.eq.0) then
+          write(*,*) "concentrations: Error; no water vapor tracer !!!"
+          stop
+        endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     fill local array of tracer indexes
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+        gind(i_co2)   =  g_co2			! co2
+        gind(i_co)    =  g_co			! co
+        gind(i_o)     =  g_o			! o
+        gind(i_o1d)   =  g_o1d			! o1d
+        gind(i_o2)    =  g_o2			! o2
+        gind(i_o3)    =  g_o3			! o3
+        gind(i_h)     =  g_h			! h
+        gind(i_h2)    =  g_h2			! h2
+        gind(i_oh)    =  g_oh			! oh
+        gind(i_ho2)   =  g_ho2			! ho2
+        gind(i_h2o2)  =  g_h2o2			! h2o2
+        gind(i_n2)    =  g_n2			! n2
+        gind(i_ar)    =  g_ar			! ar
+        gind(i_h2o)   =  g_h2o_vap		! h2o
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     Thermal conductivity and specific heat coefficients
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+        aki(i_co2)  = 3.072e-4
+        aki(i_co)   = 4.87e-4
+        aki(i_o)    = 7.59e-4
+        aki(i_o1d)  = 7.59e-4		!?
+        aki(i_o2)   = 5.68e-4
+        aki(i_o3)   = 3.00e-4		!?
+        aki(i_h)    = 0.0
+        aki(i_h2)   = 36.314e-4
+        aki(i_oh)   = 7.00e-4		!?
+        aki(i_ho2)  = 0.0
+        aki(i_h2o2) = 0.0
+        aki(i_n2)   = 5.6e-4
+        aki(i_ar)   = 0.0                 !?
+        aki(i_h2o)  = 0.0
+
+        cpi(i_co2)   = 0.834e3
+        cpi(i_co)    = 1.034e3
+        cpi(i_o)     = 1.3e3
+        cpi(i_o1d)   = 1.3e3		!?
+        cpi(i_o2)    = 0.9194e3
+        cpi(i_o3)    = 0.800e3	!?
+        cpi(i_h)     = 20.780e3
+        cpi(i_h2)    = 14.266e3
+        cpi(i_oh)    = 1.045e3
+        cpi(i_ho2)   = 1.065e3	!?
+        cpi(i_h2o2)  = 1.000e3	!?
+        cpi(i_n2)    = 1.034e3
+        cpi(i_ar)    = 1.000e3    !?
+        cpi(i_h2o)   = 1.870e3
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+        nlayer=nlayermx
+        ngrid=ngridmx
+        nq=nqmx
+
+        firstcall=.false.
+      endif ! of if (firstcall)
+
+      DO l=1,nlayer
+        DO ig=1,ngrid
+          DO n=1,ncomptot
+            q2(ig,l,n)=max(1.e-30,
+     .         pq(ig,l,gind(n))+pdq(ig,l,gind(n))*ptimestep)
+          ENDDO
+          zt(ig,l)=pt(ig,l) +pdt(ig,l)*ptimestep
+        ENDDO
+      ENDDO
+  
+      do l=1,nlayermx
+        do ig=1,ngridmx
+          ntot=pplay(ig,l)/(1.381e-23*zt(ig,l))*1.e-6  ! in #/cm3
+          cpnew(ig,l)=0.
+          akknew(ig,l)=0.
+          mmean(ig,l)=0.
+          q2tot(ig,l)=0.
+          nt=0.
+          do n=1,ncomptot
+            ni(n)=0.0 
+            do k=1,ncomptot
+              if(k.ne.n) ni(n)=ni(n)+q2(ig,l,k)/mmol(gind(k))
+            enddo
+            ni(n)=ntot/(1.+mmol(gind(n))/q2(ig,l,n)*ni(n))
+            cpnew(ig,l)=cpnew(ig,l)+ni(n)*cpi(n)
+            akknew(ig,l)=akknew(ig,l)+ni(n)*aki(n)
+            mmean(ig,l)=mmean(ig,l)+q2(ig,l,n)/mmol(gind(n))
+            q2tot(ig,l)=q2tot(ig,l)+q2(ig,l,n)
+c        if(ig.eq.1.and.l.eq.1) write(*,*)'q2tot(ig,l)',n,q2tot(ig,l) 
+            if(cpi(n) .ne. 0.0) nt=nt+ni(n)
+          enddo 
+
+c     print*,"concentrations rep 3",l,ig,nt,mmean(ig,l),zt(ig+1,l)
+
+          cpnew(ig,l)=cpnew(ig,l)/nt
+          akknew(ig,l)=akknew(ig,l)/nt
+          mmean(ig,l)=1/mmean(ig,l)    ! in amu
+          rnew(ig,l)=8.314/mmean(ig,l)*1.e3     ! J/kg/K		
+        enddo
+c        print*,l,mmean(1,l),cpnew(1,l),rnew(1,l)
+c         write(228,*),l,pplay(1,l),ntot
+      enddo
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/conduction.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/conduction.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/conduction.F	(revision 46)
@@ -0,0 +1,186 @@
+       SUBROUTINE conduction(ptimestep,pplay,pplev,pt,pdt,
+     $                   tsurf,zzlev,zzlay,zdtconduc)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Molecular thermal conduction
+c   
+c   N. Descamp, F. Forget 05/1999
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+c   arguments:
+c   ----------
+
+      REAL ptimestep
+      REAL pplay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      real zzlev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      real pdt(ngridmx,nlayermx)
+      real tsurf(ngridmx)
+
+      real zdtconduc(ngridmx,nlayermx)
+
+c   local:
+c   ------
+
+      INTEGER i,ig,l
+      INTEGER,SAVE :: ngrid, nz
+      real Akk
+      real,save :: phitop
+      real m,tmean
+      REAL alpha(nlayermx)
+      real zt(nlayermx)
+      REAL lambda(nlayermx)
+      real muvol(nlayermx)
+      REAL C(nlayermx)
+      real D(nlayermx)
+      real den(nlayermx)
+      REAL pdtc(nlayermx)
+      real zlay(nlayermx)
+      real zlev(nlayermx+1)
+
+c   constants used locally
+c    ---------------------
+c     The atmospheric conductivity is a function of temperature T :
+c      conductivity = Akk* T**skk
+      REAL,PARAMETER :: skk=0.69
+      
+      logical,save :: firstcall=.true.
+
+c-----------------------------------------------------------------------
+c   calcul des coefficients alpha et lambda
+c-----------------------------------------------------------------------
+
+      IF (firstcall) THEN
+!        write (*,*)'conduction: coeff to compute molecular',
+!     &             ' conductivity Akk,skk'
+!        write(*,*) Akk,skk
+! NB: Akk is undefined at this stage
+        write (*,*)'conduction: coeff to compute molecular',
+     &             ' conductivity skk = ', skk
+
+! Initialize phitop
+        phitop=0.0
+! Initialize ngrid and nz
+        ngrid=ngridmx
+        nz=nlayermx
+        
+        firstcall = .false.
+      ENDIF ! of IF (firstcall)
+
+      do ig=1,ngrid
+
+        zt(1)=pt(ig,1)+pdt(ig,1)*ptimestep
+c        zlay(1)=-log(pplay(ig,1)/pplev(ig,1))*Rnew(ig,1)*zt(1)/g
+c        zlev(1)=0.0
+        zlay(1)=zzlay(ig,1)
+        zlev(1)=zzlev(ig,1)
+      
+        do i=2,nz
+
+          zt(i)=pt(ig,i)+pdt(ig,i)*ptimestep 
+c          tmean=zt(i)
+c          if(zt(i).ne.zt(i-1))
+c     &    tmean=(zt(i)-zt(i-1))/log(zt(i)/zt(i-1))
+c          zlay(i)= zlay(i-1)
+c     &          -log(pplay(ig,i)/pplay(ig,i-1))*Rnew(ig,i-1)*tmean/g
+c          zlev(i)= zlev(i-1)
+c     &         -log(pplev(ig,i)/pplev(ig,i-1))*Rnew(ig,i-1)*tmean/g
+        zlay(i)=zzlay(ig,i)
+        zlev(i)=zzlev(ig,i)
+        enddo
+        
+c        zlev(nz+1)= zlev(nz)
+c     &         -log(max(pplev(ig,nz+1),1.e-30)/pplev(ig,nz))
+c     &           *Rnew(ig,nz)*tmean/g
+c        if(pplev(ig,nz+1).eq.0.) 
+c     &     zlev(nz+1)=zlev(nz)+(zlay(nz)-zlay(nz-1))
+      
+        zlev(nz+1)= zlev(nz)+10000.
+
+        Akk=Akknew(ig,1) 
+        lambda(1) = Akk*tsurf(ig)**skk/zlay(1)   
+
+        DO i = 2 , nz
+          Akk=Akknew(ig,i) 
+          lambda(i)=Akk*zt(i)**skk/(zlay(i)-zlay(i-1)) 
+        ENDDO
+        DO i=1,nz-1
+          muvol(i)=pplay(ig,i)/(rnew(ig,i)*zt(i)) 
+          alpha(i)=cpnew(ig,i)*(muvol(i)/ptimestep)
+     $                        *(zlev(i+1)-zlev(i))
+        ENDDO
+
+        muvol(nz)=pplay(ig,nz)/(rnew(ig,nz)*zt(nz)) 
+        alpha(nz)=cpnew(ig,i)*(muvol(nz)/ptimestep)
+     $                       *(zlev(nz+1)-zlev(nz))
+
+c--------------------------------------------------------------------
+c
+c     calcul des coefficients C et D
+c
+c-------------------------------------------------------------------
+
+        den(1)=alpha(1)+lambda(2)+lambda(1)
+        C(1)=lambda(1)*(tsurf(ig)-zt(1))+lambda(2)*(zt(2)-zt(1))
+        C(1)=C(1)/den(1)	     
+        D(1)=lambda(2)/den(1)           
+   
+        DO i = 2,nz-1
+          den(i)=alpha(i)+lambda(i+1)
+          den(i)=den(i)+lambda(i)*(1-D(i-1))
+           
+          C(i) =lambda(i+1)*(zt(i+1)-zt(i)) 
+     $         +lambda(i)*(zt(i-1)-zt(i)+C(i-1))    
+          C(i) =C(i)/den(i)           
+
+          D(i) =lambda(i+1) / den(i)
+        ENDDO 
+
+        den(nz)=alpha(nz) + lambda(nz) * (1-D(nz-1))
+        C(nz)=C(nz-1)+zt(nz-1)-zt(nz) 
+        C(nz)=(C(nz)*lambda(nz)+phitop) / den(nz) 
+       	 	
+c----------------------------------------------------------------------
+c
+c      calcul de la nouvelle temperature ptconduc
+c
+c----------------------------------------------------------------------
+
+        DO i=1,nz
+          pdtc(i)=0.
+        ENDDO
+        pdtc(nz)=C(nz)
+        DO i=nz-1,1,-1
+          pdtc(i)=C(i)+D(i)*pdtc(i+1)
+        ENDDO 
+c-----------------------------------------------------------------------
+c
+c     calcul de la tendance zdtconduc
+c
+c-----------------------------------------------------------------------
+    
+        DO i=1,nz
+          zdtconduc(ig,i)=pdtc(i)/ptimestep
+        ENDDO
+
+      enddo ! of do ig=1,ngrid
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/dtridgl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/dtridgl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/dtridgl.F	(revision 46)
@@ -0,0 +1,36 @@
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+
+C  GCM2.0  Feb 2003
+
+C     DOUBLE PRECISION VERSION OF TRIDGL
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+      DIMENSION AS(NMAX),DS(NMAX)
+
+C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*    A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C*    WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+
+C======================================================================C
+
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+
+      DO I=2,L
+        X         = 1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+        AS(L+1-I) = AF(L+1-I)*X
+        DS(L+1-I) = (DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+      END DO
+ 
+      XK(1)=DS(1)
+      DO I=2,L
+        XKB   = XK(I-1)
+        XK(I) = DS(I)-AS(I)*XKB
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/euvheat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/euvheat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/euvheat.F	(revision 46)
@@ -0,0 +1,204 @@
+      SUBROUTINE euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,pq,pdq,pdteuv)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing heating rate due to EUV absorption
+c
+c   author:  MAC 2002
+c   ------
+c
+c   input:
+c   ----- 
+c   dist_sol		  sun-Mars distance (AU)
+c   mu0(ngridmx)           
+c   pplay(ngrid,nlayer)   pressure at middle of layers (Pa)
+c
+c   output:
+c   -------
+c
+c   pdteuv(ngrid,nlayer)      Heating rate (K/s)
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+
+      REAL pplay(ngridmx,nlayermx)
+      REAL zzlay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx)
+      real zday
+      REAL dist_sol
+      real mu0(ngridmx)
+      real pq(ngridmx,nlayermx,nqmx)
+      real pdq(ngridmx,nlayermx,nqmx)
+      real ptimestep,ptime
+
+
+      REAL pdteuv(ngridmx,nlayermx)
+c
+c    Local variables :
+c    -----------------
+      integer nespeuv
+      parameter (nespeuv=6)
+
+      INTEGER l,iq,ig,n,inif ! , ngrid, nlayer
+      real rm(nlayermx,nespeuv)		! number density (cm-3)
+      real zq(ngridmx,nlayermx,nqmx) ! local updated tracer quantity
+      real zt(ngridmx,nlayermx) ! local updated atmospheric temperature
+      real zlocal(nlayermx)
+      real zenit
+      real aux1(nlayermx)
+      real aux2(nlayermx)
+      real jtot(nlayermx)
+      real dens						! amu/cm-3
+      real tx(nlayermx)
+      real tmean
+      
+! tracer indexes for the EUV heating:
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_h2=4
+      integer,parameter :: i_h2o=5
+      integer,parameter :: i_h2o2=6
+      
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_o=0
+      integer,save :: g_o2=0
+      integer,save :: g_h2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_h2o=0
+
+
+      logical,save :: firstcall=.true.
+
+! Initializations and sanity checks:
+
+      if (firstcall) then
+        if ((nespeuv.gt.nqmx).or.(nespeuv.gt.ncomp)) then
+          print*,'******* Dimension problem in EUVHEAT ********'
+          STOP
+        endif
+
+        ! identify the indexes of the tracers we'll need
+        g_co2=igcm_co2
+        if (g_co2.eq.0) then
+          write(*,*) "euvheat: Error; no CO2 tracer !!!"
+          stop
+        endif
+        g_o=igcm_o
+        if (g_o.eq.0) then
+          write(*,*) "euvheat: Error; no O tracer !!!"
+          stop
+        endif
+        g_o2=igcm_o2
+        if (g_o2.eq.0) then
+          write(*,*) "euvheat: Error; no O2 tracer !!!"
+          stop
+        endif
+        g_h2=igcm_h2
+        if (g_h2.eq.0) then
+          write(*,*) "euvheat: Error; no H2 tracer !!!"
+          stop
+        endif
+        g_h2o2=igcm_h2o2
+        if (g_h2o2.eq.0) then
+          write(*,*) "euvheat: Error; no H2O2 tracer !!!"
+          stop
+        endif
+        g_h2o=igcm_h2o_vap
+        if (g_h2o.eq.0) then
+          write(*,*) "euvheat: Error; no water vapor tracer !!!"
+          stop
+        endif
+        
+        firstcall= .false.
+!        print*,'EUV',nlayer,nlayermx,ngrid,ngridmx   
+      endif ! of if (firstcall)
+
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      ! build local updated values of tracers and temperature
+      do l=1,nlayermx
+        do ig=1,ngridmx
+          ! chemical species
+          zq(ig,l,g_co2)=pq(ig,l,g_co2)+pdq(ig,l,g_co2)*ptimestep
+          zq(ig,l,g_o2)=pq(ig,l,g_o2)+pdq(ig,l,g_o2)*ptimestep
+          zq(ig,l,g_o)=pq(ig,l,g_o)+pdq(ig,l,g_o)*ptimestep
+          zq(ig,l,g_h2)=pq(ig,l,g_h2)+pdq(ig,l,g_h2)*ptimestep
+          zq(ig,l,g_h2o2)=pq(ig,l,g_h2o2)+pdq(ig,l,g_h2o2)*ptimestep
+          zq(ig,l,g_h2o)=pq(ig,l,g_h2o)+pdq(ig,l,g_h2o)*ptimestep
+          ! atmospheric temperature
+          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
+        enddo
+      enddo
+
+      call flujo(solarcondate)
+c     call flujo(solarcondate+zday/365.) ! version with EUV time evolution
+
+      do ig=1,ngridmx
+
+        zenit=acos(mu0(ig))*180./acos(-1.)
+ 
+        do l=1,nlayermx
+          dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21
+          rm(l,i_co2)  = zq(ig,l,g_co2)  * dens / mmol(g_co2)
+          rm(l,i_o2)   = zq(ig,l,g_o2)   * dens / mmol(g_o2)
+          rm(l,i_o)    = zq(ig,l,g_o)    * dens / mmol(g_o)
+          rm(l,i_h2)   = zq(ig,l,g_h2)   * dens / mmol(g_h2)
+          rm(l,i_h2o)  = zq(ig,l,g_h2o)  * dens / mmol(g_h2o)
+          rm(l,i_h2o2) = zq(ig,l,g_h2o2) * dens / mmol(g_h2o2)
+        enddo
+
+c        zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))
+c     &            *Rnew(ig,1)*zt(ig,1)/g
+        zlocal(1)=zzlay(ig,1)
+        zlocal(1)=zlocal(1)/1000.
+        tx(1)=zt(ig,1)
+
+        do l=2,nlayermx
+          tx(l)=zt(ig,l)
+          tmean=tx(l)
+          if(tx(l).ne.tx(l-1))
+     &    tmean=(tx(l)-tx(l-1))/log(tx(l)/tx(l-1))
+c          zlocal(l)= zlocal(l-1)
+c     &   -log(pplay(ig,l)/pplay(ig,l-1))*Rnew(ig,l-1)*tmean/g/1000.
+        zlocal(l)=zzlay(ig,l)/1000.
+        enddo
+
+        call hrtherm (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
+     &                rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),
+     &                aux1,aux2,tx,nlayermx,zlocal,
+     &                solarcondate+zday/365.,zenit,jtot)
+
+        do l=1,nlayermx
+          pdteuv(ig,l)=0.16*jtot(l)/10.
+     &            /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l)))
+     &                  *(1.52/dist_sol)**2 
+
+        enddo	
+
+      enddo  ! of do ig=1,ngridmx
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/flujo.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/flujo.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/flujo.F	(revision 46)
@@ -0,0 +1,48 @@
+c***************************************************
+
+      subroutine flujo(date)
+
+
+c     fgg           nov 2002     first version
+c***************************************************
+
+      implicit none
+
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+
+c     Arguments
+
+      real date
+
+
+c     Local variable and constants
+
+      integer i
+      integer inter
+      real    nada
+
+c*************************************************
+
+      if(date.lt.1985.) date=1985.
+      if(date.gt.2001.) date=2001.
+      
+      do i=1,ninter
+        if(i.le.24) then
+          fluxtop(i)=(((ct1(i)+p1(i)*date)/2.)
+     $                *sin(2.*3.1416/11.*(date-1985.-3.1416))
+     $                +(ct2(i)+p2(i)*date)+1.)*fluxtophr(i)
+        else
+          fluxtop(i)=fluxtophr(i)
+        end if
+      end do
+     
+      return
+      end
+      
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/getch.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/getch.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/getch.F	(revision 46)
@@ -0,0 +1,76 @@
+c***************************************************************************
+       subroutine getch (tt)
+
+c	NOV 98	MALV 		First Version. From the work:
+c                               Rodrigo et al, Atmosfera, 3, pp.31-43, 19990
+c       apr 02  FGG             New reactions
+c       jul 03  MAC             Updated to agree with lower atmosphere
+c***************************************************************************
+	
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c Arguments 	
+      real*8 		tt		! Temperature 
+
+
+c**************************************************************************
+
+ch2: h + o2 + co2 --> ho2 + co2
+      ch2 = 1.3d-31 * exp(tt / 300.) ** (-1.6)
+
+ch3: o + ho2 --> oh + o2
+      ch3 = 3.0d-11 * exp(200.d0 / tt)
+
+ch4: co + oh --> co2 + h
+      ch4 = 1.57d-13 + 3.54d-33
+
+ch5: ho2 + ho2 --> h2o2 + o2
+      ch5 = 1.5d-12 * exp(19.d0 / tt)
+
+ch7: oh + ho2 --> h2o + o2
+      ch7 = 4.8d-11 * exp(250.d0 / tt)
+
+ch9: o(1d) + h2o --> 2oh
+      ch9 = 2.2d-10
+
+ch10: o + o + co2 --> o2 + co2
+      ch10 = 2.5 * 5.2d-35 * exp(900. / tt) 
+
+ch11: o + oh --> o2 + h
+      ch11 = 2.2d-11 * exp(120.d0 / tt)
+
+ch13: h + ho2 --> h2 + o2
+      ch13 = 6.48d-12
+
+ch14: o(1d) + h2 --> h + oh
+      ch14 = 1.1d-10
+
+ch15: oh + h2 --> h + h2o
+      ch15 = 5.5d-12 * exp (-2000.d0 / tt)
+
+ch18: oh + h2o2 --> h2o + ho2
+      ch18 = 2.9d-12 * exp (-160.d0 / tt)
+
+ch19: o(1d) + co2 --> o + co2
+      ch19 = 7.4d-11 * exp(120.d0 / tt)
+
+ch20: o(1d) + o2 --> o + o2
+      ch20 = 3.2d-11 * exp (70.d0 / tt)
+
+ch21: o + o2 + co2 --> o3 + co2
+      ch21 = 2.5 * 6.0d-34 * (tt / 300.) ** (-2.4) 
+
+      return 
+      end
+
+
+
+
+
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/hrtherm.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/hrtherm.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/hrtherm.F	(revision 46)
@@ -0,0 +1,100 @@
+c**********************************************************************
+
+      subroutine hrtherm
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit,jtot)
+
+
+c     feb 2002        fgg           first version
+c     nov 2002        fgg           second version
+
+c**********************************************************************
+
+      implicit none
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+      include 'callkeys.h'
+
+
+c    local parameters and variables
+
+      real       xabsi(nabs,nzmax) 			!densities
+      real       nada
+      real       jergs(ninter,nabs,nzmax)
+      
+      integer    i,j,k,indexint          !indexes
+      character  dn
+
+
+c     input and output variables
+
+      integer    nz                          !number of layers
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       aux1(nz)	  	             !auxiliar variable
+      real       aux2(nz)                    !auxiliar variable
+      real       jtot(nz)                    !output: heating rate(erg/s)
+      real       tx(nz)                      !temperature
+      real       date
+      real       zenit
+      real       iz(nz)
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+c*************************PROGRAM STARTS*******************************
+
+c      if (firstcall) then
+c        if(.not. thermochem) call param_read
+c        firstcall= .false.
+c      endif
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+      if(dn.eq.'n') then
+        do i=1,nz                                    
+	      jtot(i)=0.
+        enddo       
+        return
+      endif 
+     
+      do i=1,nz
+         xabsi(1,i) = co2x(i)
+         xabsi(2,i) = o2x(i)
+         xabsi(3,i) = o3px(i)
+         xabsi(4,i) = h2ox(i)
+         xabsi(5,i) = h2x(i)
+         xabsi(6,i) = h2o2x(i)
+         jtot(i) = 0.
+      end do
+
+      if(.not. thermochem) then
+        call jthermcalc
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
+      endif
+
+      do i=1,nz
+        do j=1,nabs
+          do indexint=1,33
+            jergs(indexint,j,i) = jfotsout(indexint,j,i) 
+     $              * xabsi (j,i) * fluxtop(indexint)  
+     $              / (0.5e9 * freccen(indexint))
+            jtot(i)=jtot(i)+jergs(indexint,j,i)
+          end do
+        end do
+      end do
+
+      return
+
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_newstart.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_newstart.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_newstart.F	(revision 46)
@@ -0,0 +1,621 @@
+      subroutine inichim_newstart(pq,ps,sig,nq,latfi,lonfi,airefi,
+     $ thermo,qsurf)
+
+      implicit none
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c  Initialization of the composition for use in the building of a new start file
+c  used by program newstart.F
+c  also used by program testphys1d.F
+c
+c   Author:   Sebastien Lebonnois (08/11/2002)
+c   -------
+c Revised 07/2003 by Monica Angelats-i-Coll to use input files
+c Modified 10/2008 Identify tracers by their names Ehouarn Millour
+c
+c   Arguments:
+c   ----------
+c
+c    pq(iip1,jjp1,llm,nqmx)  Advected fields, ie chemical species here
+c    sig = sigma                vertical coordinate (interface of layers)
+c    nq: number of tracers to initialize (used to evaluate if only
+c        chemistry species are to be initialized or if water vapour
+c        and water ice should also be initialized. 
+c        NB: number of chemistry tracers is ncomp (set in chimiedata.h)
+c=======================================================================
+
+c    Declarations :
+c    --------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "comcstfi.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "temps.h"
+#include "datafile.h"
+
+c Arguments :
+c -----------
+
+      real    ps(iip1,jjp1)
+      real    pq(iip1,jjp1,llm,nqmx)     ! Advected fields, ie chemical species
+      real    sig(llm+1)                 ! vertical coordinate (interface of layers)
+      integer nq            !  =nqmx 
+                            ! or =nqmx-1 if H2O kept
+                            ! or =nqmx-2 if H2O and ice kept
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+      integer thermo ! flag for thermosphere initialisation only
+      real :: qsurf(ngridmx,nqmx) ! surface tracers
+
+c Local variables :
+c -----------------
+
+      integer  iq,i,j,l,n, nspecini,inil,iqmax,iiq
+      INTEGER aa(nqmx)
+      REAL qtot(iip1,jjp1,llm)
+      real densconc,zgcm,zfile(252),vmrint,nt, mmean
+      real nxf(252),zfilemin(252),sigfile(252)
+      real vmrf(252,14),nf(252,14)
+      real tfile(252),zzfile(252)
+      real ni(14),niold(14)
+      real mmolf(14)    ! molecular mass in amu (species in files)
+      data mmolf/44.,40.,28.,32.,28.,16.,2.,   ! majors
+     &           1.,17.,33.,18.,34.,16.,48./   ! minors
+      character*3 tmp ! temporary variable
+      integer ierr,lnblnk
+      external lnblnk
+
+      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+      character(len=20) :: txt ! to store some text
+      integer :: nqchem_start,count
+      integer :: nqchem(nqmx) ! local chemistry tracer index array
+      integer :: nbqchem ! total number of chemical species (water included)
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+! read in 'callphys.def'
+       call inichim_readcallphys()
+
+      ! check if tracers have 'old' names
+      oldnames=.false.
+      count=0
+      do iq=1,nqmx
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.noms(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+
+      if (count.eq.nqmx) then
+        write(*,*) "inichim_newstart: tracers seem to follow old ",
+     &             "naming convention (q01,q02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should rename them"
+        oldnames=.true.
+      endif
+
+      ! copy/set tracer names
+      if (oldnames) then ! old names (derived from iq & option values)
+        ! 1. dust:
+        if (dustbin.ne.0) then ! transported dust
+          do iq=1,dustbin
+            txt=" "
+            write(txt,'(a4,i2.2)') 'dust',iq
+            noms(iq)=txt
+            mmol(iq)=100.
+          enddo
+          ! special case if doubleq
+          if (doubleq) then
+            if (dustbin.ne.2) then
+              write(*,*) 'initracer: error expected dustbin=2'
+            else
+              noms(1)='dust_mass'   ! dust mass mixing ratio
+              noms(2)='dust_number' ! dust number mixing ratio
+            endif
+          endif
+        endif
+        ! 2. water & ice
+        if (water) then
+          noms(nqmx)='h2o_vap'
+          mmol(nqmx)=18.
+          noms(nqmx-1)='h2o_ice'
+          mmol(nqmx-1)=18.
+        endif
+        ! 3. Chemistry
+        if (photochem .or. callthermos) then
+          if (doubleq) then
+            nqchem_start=3
+          else
+            nqchem_start=dustbin+1
+          end if
+        endif ! of if (photochem .or. callthermos)
+        do iq=nqchem_start,nqchem_start+ncomp-1
+          noms(iq)=nomchem(iq-nqchem_start+1)
+          mmol(iq)=mmolchem(iq-nqchem_start+1)
+        enddo
+        ! 4. Other tracers ????
+        if ((dustbin.eq.0).and.(.not.water)) then
+          noms(1)='co2'
+          mmol(1)=44
+          if (nqmx.eq.2) then
+            noms(nqmx)='Ar_N2'
+            mmol(nqmx)=30
+          endif
+        endif
+      else
+        ! noms(:) already contain tracer names
+        ! mmol(:) array is initialized later (see below)
+      endif ! of if (oldnames)
+
+      ! special modification when using 'old' tracers:
+      ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
+      ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
+      if (oldnames.and.water) then
+        write(*,*)'inichim_newstart: moving surface water ice to index '
+     &            ,nqmx-1
+        qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx)
+        qsurf(1:ngridmx,nqmx)=0
+      endif 
+
+c Dimension test:
+c ---------------
+
+       if (water) then
+!         if ((nqchem_min+ncomp+1).ne.nqmx) then
+         if ((dustbin+ncomp+2).ne.nqmx) then
+!            print*,'********* Dimension problem! ********'
+!            print*,"nqchem_min+ncomp+1).ne.nqmx"
+            print*,'inichim_newstart: tracer dimension problem:'
+            print*,"(dustbin+ncomp+2).ne.nqmx"
+            print*,"ncomp: ",ncomp
+!            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       else
+!         if ((nqchem_min+ncomp).ne.nqmx) then
+          if ((dustbin+ncomp+1).ne.nqmx) then
+!            print*,'********* Dimension problem! ********'
+!            print*,"nqchem_min+ncomp).ne.nqmx"
+            print*,'initracer: tracer dimension problem:'
+            print*,"(dustbin+ncomp+1).ne.nqmx"
+            print*,"ncomp: ",ncomp
+!            print*,"nqchem_min: ",nqchem_min
+            print*,"nqmx: ",nqmx
+            print*,'Change ncomp in chimiedata.h'
+            STOP
+         endif
+       endif
+
+c noms and mmol vectors:
+c ----------------------
+!
+!       if (iceparty) then
+!          do iq=nqchem_min,nqmx-2
+!            noms(iq) = nomchem(iq-nqchem_min+1)
+!            mmol(iq) = mmolchem(iq-nqchem_min+1)
+!          enddo
+!          noms(nqmx-1) = 'ice'
+!          mmol(nqmx-1) = 18.
+!          noms(nqmx)   = 'h2o'
+!          mmol(nqmx)   = 18.
+!       else
+!          do iq=nqchem_min,nqmx-1
+!            noms(iq) = nomchem(iq-nqchem_min+1)
+!            mmol(iq) = mmolchem(iq-nqchem_min+1)
+!          enddo
+!          noms(nqmx)   = 'h2o'
+!          mmol(nqmx)   = 18.
+!       endif
+!       if (nqchem_min.gt.1) then
+!          do iq=1,nqchem_min-1
+!            noms(iq) = 'dust'
+!            mmol(iq) = 100.
+!          enddo
+!       endif
+
+
+! Identify tracers by their names: (and set corresponding values of mmol)
+      ! 0. initialize tracer indexes to zero:
+      do iq=1,nqmx
+        igcm_dustbin(iq)=0
+      enddo
+      igcm_dust_mass=0
+      igcm_dust_number=0
+      igcm_h2o_vap=0
+      igcm_h2o_ice=0
+      igcm_co2=0
+      igcm_co=0
+      igcm_o=0
+      igcm_o1d=0
+      igcm_o2=0
+      igcm_o3=0
+      igcm_h=0
+      igcm_h2=0
+      igcm_oh=0
+      igcm_ho2=0
+      igcm_h2o2=0
+      igcm_n2=0
+      igcm_ar=0
+      igcm_ar_n2=0
+
+      ! 1. find dust tracers
+      count=0
+      if (dustbin.gt.0) then
+        do iq=1,nqmx
+          txt=" "
+          write(txt,'(a4,i2.2)')'dust',count+1
+          if (noms(iq).eq.txt) then
+            count=count+1
+            igcm_dustbin(count)=iq
+            mmol(iq)=100.
+          endif
+        enddo !do iq=1,nqmx
+      endif ! of if (dustbin.gt.0)
+      if (doubleq) then
+        do iq=1,nqmx
+          if (noms(iq).eq."dust_mass") then
+            igcm_dust_mass=iq
+            count=count+1
+          endif
+          if (noms(iq).eq."dust_number") then
+            igcm_dust_number=iq
+            count=count+1
+          endif
+        enddo
+      endif ! of if (doubleq)
+      ! 2. find chemistry and water tracers
+      nbqchem=0
+      do iq=1,nqmx
+        if (noms(iq).eq."co2") then
+          igcm_co2=iq
+          mmol(igcm_co2)=44.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."co") then
+          igcm_co=iq
+          mmol(igcm_co)=28.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."o") then
+          igcm_o=iq
+          mmol(igcm_o)=16.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."o1d") then
+          igcm_o1d=iq
+          mmol(igcm_o1d)=16.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."o2") then
+          igcm_o2=iq
+          mmol(igcm_o2)=32.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."o3") then
+          igcm_o3=iq
+          mmol(igcm_o3)=48.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."h") then
+          igcm_h=iq
+          mmol(igcm_h)=1.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."h2") then
+          igcm_h2=iq
+          mmol(igcm_h2)=2.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."oh") then
+          igcm_oh=iq
+          mmol(igcm_oh)=17.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."ho2") then
+          igcm_ho2=iq
+          mmol(igcm_ho2)=33.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."h2o2") then
+          igcm_h2o2=iq
+          mmol(igcm_h2o2)=34.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."n2") then
+          igcm_n2=iq
+          mmol(igcm_n2)=28.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."ar") then
+          igcm_ar=iq
+          mmol(igcm_ar)=40.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."h2o_vap") then
+          igcm_h2o_vap=iq
+          mmol(igcm_h2o_vap)=18.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        if (noms(iq).eq."h2o_ice") then
+          igcm_h2o_ice=iq
+          mmol(igcm_h2o_ice)=18.
+          count=count+1
+          nbqchem=nbqchem+1
+        endif
+        ! Other stuff: e.g. for simulations using co2 + neutral gaz
+        if (noms(iq).eq."Ar_N2") then
+          igcm_ar_n2=iq
+          mmol(igcm_ar_n2)=30.
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+      
+      ! check that we identified all tracers:
+      if (count.ne.nqmx) then
+        write(*,*) "inichim_newstart: found only ",count," tracers"
+        write(*,*) "               expected ",nqmx
+        do iq=1,count
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+        stop
+      else
+       write(*,*)"inichim_newstart: found all expected tracers, namely:"
+        do iq=1,nqmx
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+      endif
+
+      ! build local chemistry tracer index array nqchem(:)
+      ! as in the old days, water vapour is last and water ice,
+      ! if present, is just before water vapour
+      nqchem(1)=igcm_co2
+      nqchem(2)=igcm_co
+      nqchem(3)=igcm_o
+      nqchem(4)=igcm_o1d
+      nqchem(5)=igcm_o2
+      nqchem(6)=igcm_o3
+      nqchem(7)=igcm_h
+      nqchem(8)=igcm_h2
+      nqchem(9)=igcm_oh
+      nqchem(10)=igcm_ho2
+      nqchem(11)=igcm_h2o2
+      nqchem(12)=igcm_n2
+      nqchem(13)=igcm_ar
+      nqchem(14)=igcm_h2o_ice
+      nqchem(15)=igcm_h2o_vap
+
+! Load in chemistry data for initialization:
+c----------------------------------------------------------------------
+c Order of Major species in file:
+c
+c    1=CO2 
+c    2=AR
+c    3=N2  
+c    4=O2  
+c    5=CO  
+c    6=O   
+c    7=H2
+c
+c Order of Minor species in files:
+c
+c    1=H  
+c    2=OH 
+c    3=HO2 
+c    4=H2O 
+c    5=H2O2 
+c    6=O1D
+c    7=O3
+c
+c----------------------------------------------------------------------
+c Major species:
+        aa(igcm_co2) = 1
+        aa(igcm_ar)  = 2
+        aa(igcm_n2)  = 3
+        aa(igcm_o2)  = 4
+        aa(igcm_co)  = 5
+        aa(igcm_o)   = 6
+        aa(igcm_h2)  = 7
+c Minor species:
+        aa(igcm_h)       = 8
+        aa(igcm_oh)      = 9
+        aa(igcm_ho2)     = 10
+        aa(igcm_h2o_vap) = 11
+        aa(igcm_h2o2)    = 12
+        aa(igcm_o1d)     = 13 
+        aa(igcm_o3)      = 14
+c----------------------------------------------------------------------
+      open(210, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_may.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_may.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_may.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+      open(220, iostat=ierr,file=
+     & datafile(1:lnblnk(datafile))//'/atmosfera_LMD_min.dat')
+      if (ierr.ne.0) then
+        write(*,*)'Error : cannot open file atmosfera_LMD_min.dat '
+        write(*,*)'(in aeronomars/inichim.F)'
+        write(*,*)'It should be in :', datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary atmosfera_LMD_min.dat (and others)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+         STOP
+      endif
+
+      read(210,*) tmp
+      read(220,*) tmp
+        do l=1,252
+          read(210,112) tfile(l),zfile(l),nxf(l),(vmrf(l,n),n=1,7)
+          zfile(l)=zfile(l)*100.              !pressure (Pa)
+          sigfile(l)=zfile(l)/zfile(1)       
+        enddo
+        do l=1,252
+          read(220,113)zfilemin(l),(vmrf(l,n),n=8,14)
+          zfilemin(l)=zfilemin(l)*1000.       !height (m)
+          do n=1,14
+            nf(l,n)=vmrf(l,n)*nxf(l)
+          enddo
+        enddo
+        close(210)
+        close(220)
+
+c flag thermo set to 1 or 0 in newstart 
+c inil=33 for initialisation of thermosphere only        
+c inil=1 for initialisation of all layers        
+        if (thermo.eq.1) then
+        inil=33
+        else
+        inil=1
+        endif
+
+! Initialization of tracers
+
+      do i=1,iip1
+       do j=1,jjp1
+        do l=inil,llm
+
+c          zgcm=sig(l)
+          zgcm=sig(l)*ps(i,j)
+          densconc=0.
+          nt=0.
+
+          do n=1,14
+            call intrplf(zgcm,vmrint,zfile,nf(1,n),252)
+c            call intrplf(zgcm,vmrint,sigfile,nf(1,n),252)
+            ni(n)=vmrint
+
+            densconc=densconc+ni(n)*mmolf(n)
+            nt=nt+ni(n)
+          enddo
+
+          mmean=densconc/nt                     ! in amu
+
+          if (nq.ne.nbqchem) then ! don't initialize water vapour
+            do n=1,nq-1
+            pq(i,j,l,nqchem(n))=
+     &                 ni(aa(nqchem(n)))/nt*mmol(nqchem(n))/mmean
+            if(i.eq.iip1) pq(i,j,l,nqchem(n))=pq(1,j,l,nqchem(n)) 
+            enddo
+            if (water .and. (nq.gt.nbqchem-2)) then
+              pq(i,j,l,nqchem(nq)) = 0.
+              if(i.eq.iip1) pq(i,j,l,nqchem(nq))=pq(1,j,l,nqchem(nq)) 
+            else
+              pq(i,j,l,nqchem(nq))=
+     &              ni(aa(nqchem(nq)))/nt*mmol(nqchem(nq))/mmean
+              if(i.eq.iip1) pq(i,j,l,nqchem(nq))=pq(1,j,l,nqchem(nq)) 
+            endif
+          endif ! of if (nq.ne.nbqchem)
+          
+          if (nq.eq.nbqchem) then ! also initialize water vapour
+            do n=1,nq-2
+              pq(i,j,l,nqchem(n))=
+     &                   ni(aa(nqchem(n)))/nt*mmol(nqchem(n))/mmean
+              if(i.eq.iip1) pq(i,j,l,nqchem(n))=pq(1,j,l,nqchem(n)) 
+            enddo
+            if (water) then
+              pq(i,j,l,nqchem(nq-1)) = 0.
+              if(i.eq.iip1) then
+                pq(i,j,l,nqchem(nq-1))=pq(1,j,l,nqchem(nq-1)) 
+              endif
+              pq(i,j,l,nqchem(nq))=
+     &                   ni(aa(nqchem(nq)))/nt*mmol(nqchem(nq))/mmean
+              if(i.eq.iip1) pq(i,j,l,nqchem(nq))=pq(1,j,l,nqchem(nq)) 
+            else
+              do n=nq-1,nq
+                pq(i,j,l,nqchem(nq))=
+     &                   ni(aa(nqchem(nq)))/nt*mmol(nqchem(nq))/mmean
+                if(i.eq.iip1) pq(i,j,l,nqchem(nq))=pq(1,j,l,nqchem(nq)) 
+              enddo
+            endif ! of if (water)
+          endif ! of if (nq.eq.nqmx)
+        enddo     !nlayer
+       enddo      !ngrid_j
+      enddo       !ngrid_i
+
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+!      iqmax=nqchem_min
+       iqmax=1
+     
+!      if ((nqmx-nqchem_min).gt.10) then
+      if (nbqchem.gt.10) then
+       do l=1,llm
+        do j=1,jjp1
+          do i=1,iip1
+!           do iq=nqchem_min,nqmx
+            do iiq=1,nbqchem
+              iq=nqchem(iiq)
+              if ( (pq(i,j,l,iq).gt.pq(i,j,l,iqmax)).and.
+     .           (noms(iq).ne."ice") )  then 
+              iqmax=iq
+              endif
+            enddo
+            pq(i,j,l,iqmax)=1.
+            qtot(i,j,l)=0
+!           do iq=nqchem_min,nqmx
+            do iiq=1,nbqchem
+             iq=nqchem(iiq)
+             if ( (iq.ne.iqmax).and.
+     .           (noms(iq).ne."ice") ) then        
+               pq(i,j,l,iqmax)=pq(i,j,l,iqmax)-pq(i,j,l,iq)        
+             endif
+            enddo !iq
+!            do iq=nqchem_min,nqmx
+            do iiq=1,nbqchem
+             iq=nqchem(iiq)
+              if (noms(iq).ne."ice") then
+                qtot(i,j,l)=qtot(i,j,l)+pq(i,j,l,iq)
+              endif
+c            if (i.eq.1.and.j.eq.1.and.l.eq.1) write(*,*) 'qtot(i,j,l)',
+c     $    qtot(i,j,l)
+            enddo !iq
+            if (i.eq.1.and.j.eq.1) write(*,*) 'inichim_newstart: ',
+     $        'qtot(i,j,l)=',qtot(i,j,l)
+          enddo !i   
+         enddo !j   
+       enddo !l  
+      endif ! of if (nbqchem.gt.10)
+ccccccccccccccccccccccccccccccc
+
+66      format(i2,6(1x,e11.5))
+112     format(7x,f7.3,3x,e12.6,3x,e12.6,7(3x,e12.6))
+113     format(1x,f6.2,7(3x,e12.6))
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_readcallphys.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_readcallphys.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inichim_readcallphys.F	(revision 46)
@@ -0,0 +1,520 @@
+      SUBROUTINE inichim_readcallphys
+!
+!=======================================================================
+!
+!   subject:
+!   --------
+!
+!   Initialisation for the physical parametrisations of the LMD 
+!   martian atmospheric general circulation model.
+!   This routine is called by inichim_newstart (which is used by programs
+!   newstart and testphys1d but not the GCM)
+!
+!   author: Frederic Hourdin 15 / 10 /93
+!   -------
+!   modifications: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+!                  10/2008 adapted to using tracer sby name. Ehouarn Millour
+!                  07/2009 use 'getin' to read callphys.def. EM
+!
+!   arguments:
+!   ----------
+!
+!   input:
+!   ------
+!
+!=======================================================================
+!
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+! to use  'getin'
+      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"
+
+      character*12 ch1
+      integer ierr
+      logical chem, h2o
+
+
+! --------------------------------------------------------------
+!  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*,' inichim_readcallphys: Parametres pour la physique',
+     &          ' (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+
+         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
+         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:"
+         iaervar=3 ! default value
+         call getin("iaervar",iaervar)
+         write(*,*) " iaervar = ",iaervar
+
+         write(*,*) "Dust vertical distribution:"
+         write(*,*) "(=1 Dust opt.deph read in startfi;",
+     & " =2 Viking scenario; =3 MGS scenario,",
+     & " =4 Mars Year 24 from TES assimilation)"
+         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
+
+! Test of incompatibility:
+! if doubleq is used, then dustbin should be 1
+
+         if (doubleq.and.(dustbin.ne.1)) then
+           print*,'if doubleq is used, then dustbin should be 1'
+           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(*,*) "includes water ice",
+     &              "(if true, 'water' must also be .true.)"
+
+         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
+         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
+
+! Test of incompatibility:
+! if activice is used, then water should be used too
+
+         if (activice.and..not.water) then
+           print*,'if activice is used, water should be used too'
+           stop
+         endif
+
+         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
+      CLOSE(99)
+
+      pi=2.*asin(1.)
+
+!     managing the tracers, and tests:
+!     -------------------------------
+
+      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.
+!        if (doubleq) then
+!          nqchem_min = 3
+!        else
+!          nqchem_min = dustbin+1
+!        end if
+       end if
+
+       if (water .or. thermoswater) h2o = .true.
+
+c          TESTS
+
+       print*,'inichim_readcallphys: TRACERS:'
+
+       if ((doubleq).and.(h2o).and.
+     $     (chem)) then
+!         print*,' 1: dust ; 2: dust (doubleq)'
+!         print*,' 3 to ',nqmx-2,': chemistry'
+!         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         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*,' 1: dust ; 2: dust (doubleq)'
+!         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         print*,' 2 dust tracers (doubleq)'
+         print*,' 1 water vapour tracer'
+         print*,' 1 water ice tracer'
+         if (nqmx.ne.4) then
+           print*,'nqmx should be 4 with these options.'
+		   print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if ((doubleq).and..not.(h2o)) then
+!         print*,' 1: dust ; 2: dust (doubleq)'
+         print*,' 2 dust tracers (doubleq)'
+         if (nqmx.ne.2) then
+           print*,'nqmx should be 2 with these options...'
+		   print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if (.not.(doubleq).and.(h2o).and.
+     $     (chem)) then
+         if (dustbin.gt.0) then
+!           print*,' 1 to ',dustbin,': dust bins'
+           print*,dustbin,' dust bins'
+         endif
+!         print*,nqchem_min,' to ',nqmx-2,': chemistry'
+!         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         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*,' 1 to ',dustbin,': dust bins'
+           print*,dustbin,' dust bins'
+         endif
+!         print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+         print*,' 1 water vapour tracer'
+         print*,' 1 water ice tracer'
+         if (nqmx.ne.(dustbin+2)) then
+           print*,'nqmx should be ',(dustbin+2),
+     $            ' with these options...'
+		   print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if (.not.(doubleq).and..not.(h2o)) then
+         if (dustbin.gt.0) then
+!           print*,' 1 to ',dustbin,': dust bins'
+           print*,dustbin,' dust bins'
+           if (nqmx.ne.dustbin) then
+             print*,'nqmx should be ',dustbin,
+     $              ' with these options...'
+             print*,'(or check callphys.def)'
+             stop
+           endif
+         else
+           print*,'dustbin=',dustbin,
+     $            ': tracer should be F with these options...'
+     $           ,'UNLESS you just want to move tracers around '
+         endif
+       endif
+
+      endif ! of if (tracer)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/init_chimie_B.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/init_chimie_B.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/init_chimie_B.F	(revision 46)
@@ -0,0 +1,83 @@
+      subroutine init_chimie_B
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c   Scheme B
+c
+c   subject:
+c   --------
+c
+c   Initialization of the photochemical scheme
+c
+c   VERSION: 30/04/2003
+c
+c   This is dependent of the chemistry version:
+c   for scheme B its only purpose is reading the
+c   photodissociation rates lookup table
+c
+c   Author:   Franck Lefevre for scheme B
+c
+c   Arguments:
+c   ----------
+c
+c   The output variable is jphot and is put in common chimiedata.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "chimiedata.h"
+#include "datafile.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer fic, ij, iozo, isza, itemp, iz, ierr
+c
+      real xsza
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      fic = 81
+
+      open(fic, form = 'formatted', status = 'old',
+     &file =trim(datafile)//'/jmars.20030707',iostat=ierr)
+
+      IF (ierr.NE.0) THEN
+        write(*,*)'Error : cannot open file jmars.20030707 '
+        write(*,*)'(in aeronomars/init_chimie_B.F)'
+        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 jmars.20030707 (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        STOP
+      ENDIF
+
+c
+      print*, 'init_chimie_B: lecture table des J...'
+c
+      do itemp = 1,ntemp
+         do iozo = 1,nozo
+            do isza = 1,nsza
+               do iz = 200,0,-1
+                  read(fic,*) colairtab(iz), xsza, table_ozo(iozo)
+                  read(fic,*) (jphot(itemp,isza,iz,iozo,ij), ij=1,7)
+                  read(fic,*) (jphot(itemp,isza,iz,iozo,ij), ij=8,11)
+                  do ij = 1,nd
+                     if (jphot(itemp,isza,iz,iozo,ij) .eq. 1.e-30) then
+                        jphot(itemp,isza,iz,iozo,ij) = 0.
+                     end if
+                  end do
+               end do
+            end do
+         end do
+      end do
+c
+      print*, 'init_chimie_B: lecture table des J...ok'
+      close(fic)
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/intrplf.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/intrplf.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/intrplf.F	(revision 46)
@@ -0,0 +1,42 @@
+c******************************************************
+      SUBROUTINE intrplf(x,y,xd,yd,nd)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+ 
+c  Version with CONSTANT values outside limits
+c**********************************************************
+ 
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(nd),yd(nd)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+ 
+c run
+c ---
+      y_undefined=1.e20
+ 
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = yd(1) ! yd(1)
+        if (xd(1).ge.xd(nd)) y = yd(nd) ! yd(1)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = yd(nd) ! yd(1)
+        if (xd(1).ge.xd(nd)) y = yd(1) ! yd(1)
+c        y = yd (nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+ 
+ 99   continue
+      return
+      end                    
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/inv.F	(revision 46)
@@ -0,0 +1,121 @@
+      SUBROUTINE inv(A,N)
+
+      implicit none
+
+c=======================================================================
+c   Scheme A
+c
+c   subject:
+c   --------
+c
+c   Inversion of a matrix:
+c   Combinaison des routines ludcmp.f et lubksb.f du Numerical Recipes
+c=======================================================================
+
+      real       TINY
+      PARAMETER (TINY=1.0E-20)
+      real       AAMAX,DUM,SUM
+      integer    IMAX,I,II,J,K,L,LL,N
+      real       A(N,N),INDX(N),VV(N,N)
+
+      IMAX = 0
+      do I=1,N
+          AAMAX=0.
+          do J=1,N
+            IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
+          enddo
+          if (AAMAX.EQ.0.) then
+              write(*,*) 'Singular matrix.'
+              stop
+          endif
+          VV(I,1)=1./AAMAX
+      enddo
+      do J=1,N
+        IF (J.GT.1) THEN
+          do I=1,J-1
+            SUM=A(I,J)
+            IF (I.GT.1)THEN
+              do K=1,I-1
+                SUM=SUM-A(I,K)*A(K,J)
+              enddo
+              A(I,J)=SUM
+            ENDIF
+          enddo
+        ENDIF
+        AAMAX=0.
+        do I=J,N
+          SUM=A(I,J)
+          IF (J.GT.1)THEN
+            do K=1,J-1
+              SUM=SUM-A(I,K)*A(K,J)
+            enddo
+            A(I,J)=SUM
+          ENDIF
+          DUM=VV(I,1)*ABS(SUM)
+          IF (DUM.GE.AAMAX) THEN
+            IMAX=I
+            AAMAX=DUM
+          ENDIF
+        enddo
+        IF (J.NE.IMAX)THEN
+          do K=1,N
+            DUM=A(IMAX,K)
+            A(IMAX,K)=A(J,K)
+            A(J,K)=DUM
+          enddo
+          VV(IMAX,1)=VV(J,1)
+        ENDIF
+        INDX(J)=IMAX
+        if(abs(A(J,J)).LT.TINY) then
+              write(*,*) 'Pivot too small.'
+              stop
+        endif
+        IF(J.NE.N)THEN
+          DUM=1./A(J,J)
+          do I=J+1,N
+            A(I,J)=A(I,J)*DUM
+          enddo
+        ENDIF
+      enddo
+
+      do I=1,N
+         do J=1,N
+            VV(I,J) = 0.
+         enddo
+         VV(I,I) = 1.
+      enddo
+
+      do L=1,N
+        II=0
+        do I=1,N
+          LL=INDX(I)
+          SUM=VV(LL,L)
+          VV(LL,L)=VV(I,L)
+          IF (II.NE.0)THEN
+            do J=II,I-1
+              SUM=SUM-A(I,J)*VV(J,L)
+            enddo
+          ELSE IF (SUM.NE.0.) THEN
+            II=I
+          ENDIF
+          VV(I,L)=SUM
+        enddo
+        do I=N,1,-1
+          SUM=VV(I,L)
+          IF(I.LT.N)THEN
+            do J=I+1,N
+              SUM=SUM-A(I,J)*VV(J,L)
+            enddo
+          ENDIF
+          VV(I,L)=SUM/A(I,I)
+        enddo
+      enddo
+
+      do I=1,N
+        do L=1,N
+          A(I,L)=VV(I,L)
+        enddo
+      enddo
+
+      return
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/jthermcalc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/jthermcalc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/jthermcalc.F	(revision 46)
@@ -0,0 +1,557 @@
+c**********************************************************************
+
+      subroutine jthermcalc
+     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
+
+
+c     feb 2002        fgg           first version
+c     nov 2002        fgg           second version
+c
+c modified from paramhr.F
+c MAC July 2003
+c**********************************************************************
+
+      implicit none
+
+c     common variables and constants
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c    local parameters and variables
+
+      real       xabsi(nabs,nzmax) !densities
+      real       nada
+      real       co2colx2(nzmax,ninter)
+      real       o2colx2(nzmax,ninter)
+      real       o3pcolx2(nzmax,ninter)
+      real       co2colx(nzmax)              !column density of CO2 (cm^-2)
+      real       o2colx(nzmax)               !column density of O2(cm^-2)
+      real       o3pcolx(nzmax)              !column density of O(3P)(cm^-2)
+      real       h2o2colx(nzmax)             !column density of H2O2(cm^-2)
+      real       t2(nzmax)
+      real       coltemp(nzmax)
+      real       dt(nzmax)
+      real       sigma(ninter,nzmax)
+      real       alfa(ninter,nzmax)
+      real       xx
+      real       grav(nzmax)
+      
+      integer    i,j,k,icol,indexint          !indexes
+      character  dn
+
+c     input and output variables
+
+      integer    nz                          !number of layers
+      real       co2x(nz)                    !density of CO2(cm^-3)
+      real       o2x(nz)                     !density of O2(cm^-3)
+      real       o3px(nz)                    !density of O(3P)(cm^-3)
+      real       h2x(nz)                     !density of H2(cm^-3)
+      real       h2ox(nz)                    !density of H2O(cm^-3)
+      real       h2o2x(nz)                   !density of H2O2(cm^-3)
+      real       aux1(nz)	             !auxiliar variable
+      real       aux2(nz)                    !auxiliar variable
+      real       tx(nz)                      !temperature
+      real       date
+      real       zenit
+      real       iz(nz)
+
+
+c     variables used in interpolation
+
+      real aux3(nz2), aux4(nz2)
+                                              !auxiliar variables
+      real       limdown                      !limits for interpolation
+      real       limup                        !        ""
+
+c*************************PROGRAM STARTS*******************************
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+      if(dn.eq.'n') then
+        return
+      endif 
+     
+      do i=1,nz
+         xabsi(1,i) = co2x(i)
+         xabsi(2,i) = o2x(i)
+         xabsi(3,i) = o3px(i)
+         xabsi(4,i) = h2ox(i)
+         xabsi(5,i) = h2x(i)
+         xabsi(6,i) = h2o2x(i)
+      end do
+
+      do i=1,nz
+         t2(i)=tx(i)
+         if(t0(i).lt.195.0) t0(i)=195.0
+         if(t0(i).gt.295.0) t0(i)=295.0
+         if(t2(i).lt.195.0) t2(i)=195.0
+         if(t2(i).gt.295.0) t2(i)=295.0
+      end do
+
+
+c    COLUMN CALCULATION 
+
+      call column(co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx
+     $,o2colx,o3pcolx,h2o2colx)
+
+      coltemp(nz)=co2colx(nz)*abs(t2(nz)-t0(nz))
+      dt(nz)=coltemp(nz)/co2colx(nz)
+      do i=nz-1,1,-1
+        coltemp(i)=coltemp(i+1)+ 
+     $         ( co2x(i) + co2x(i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * abs(t2(i)-t0(i))
+        dt(i)=coltemp(i)/co2colx(i)
+      end do
+
+
+c     Calculo la seccion eficaz de CO2 a la temperatura t0 a cada altura
+c CALCULATION OF CO2 CROSS-SECTION AT TEMPERATURE T0 AT EACH HEIGHT
+
+      do i=1,nz
+         do indexint=24,32
+           sigma(indexint,i)=co2crsc195(indexint-23)*
+     $         (1+((co2crsc295(indexint-23)/co2crsc195(indexint-23))-1.)
+     $         *(t0(i)-195.)/100.)
+           if(t0(i).ne.295.) then
+             alfa(indexint,i)=((co2crsc295(indexint-23)
+     $                        /sigma(indexint,i))-1.)/(295.-t0(i))
+           else 
+             alfa(indexint,i)=0.
+           end if
+         end do
+      end do
+
+
+c     Comienza la interpolacion
+c INTERPOLATION BEGINS
+c************************************************
+c     o2,0.1,5.0
+c************************************************
+      
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+       do i=1,nz
+         aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+       end do
+       do i=1,nz2
+         aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+         aux4(i) = c23(nz2-i+1)
+       enddo
+       call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
+       do i=1,nz
+         jfotsout(indexint,2,i) = aux1(nz-i+1)
+       enddo
+
+c************************************************
+c     o3p,0.1,5.0
+c************************************************
+
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
+            aux4(i) = c23(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
+         do i=1,nz
+            jfotsout(indexint,3,i) = aux1(nz-i+1)
+         enddo
+
+
+c************************************************
+c     h2,0.1,5.0
+c************************************************
+
+      indexint=1
+      limdown=1e-20
+      limup=1e26
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
+            aux4(i) = c23(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,5,i) = aux1(nz-i+1)
+         enddo
+
+
+c************************************************
+c     interpola para el o2 entre 5 y 90.8nm
+c************************************************
+
+      limdown=1e-20
+      limup=1e12
+      do indexint=2,16
+         co2colx2(nz,indexint)= co2colx(nz) 
+     $              * crscabsi2(1,indexint)
+         o2colx2(nz,indexint)= o2colx(nz) 
+     $              * crscabsi2(2,indexint)
+         o3pcolx2(nz,indexint)= o3pcolx(nz) 
+     $              * crscabsi2(3,indexint)
+         do i=nz-1,1,-1
+            co2colx2(i,indexint) = co2colx2(i+1,indexint) + 
+     $         ( xabsi(1,i) + xabsi(1,i+1) ) * 0.5 
+     $           * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(1,indexint)
+            o2colx2(i,indexint) = o2colx2(i+1,indexint) + 
+     $         ( xabsi(2,i) + xabsi(2,i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(2,indexint)
+            o3pcolx2(i,indexint) = o3pcolx2(i+1,indexint) + 
+     $         ( xabsi(3,i) + xabsi(3,i+1) ) * 0.5 
+     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(3,indexint)
+         end do
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint)+
+     $      o2colx2(i,indexint)+
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+          call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+          do i=1,nz
+            jfotsout(indexint,2,i) = aux1(nz-i+1) 
+          enddo
+      end do
+      
+
+c************************************************
+c     idem para o3p entre 5 y 90.8nm
+c************************************************
+
+      do indexint=2,16
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,3,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c     idem para co2 entre 5 y 90.8nm
+c************************************************
+
+      do indexint=2,16
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,1,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c     idem para h2 entre 5 y 80.6nm
+c************************************************
+
+      do indexint=2,15
+         do i=1,nz
+            aux2(nz-i+1) = co2colx2(i,indexint) +
+     $      o2colx2(i,indexint) +
+     $      o3pcolx2(i,indexint)
+         end do
+         do i=1,nabs
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
+            aux4(i) = c123(indexint,nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,5,i) = aux1(nz-i+1)
+         enddo
+      end do
+
+
+c************************************************
+c      co2,90.9,119.5
+c************************************************
+
+      limdown=1e-20
+      limup=1e26
+      do indexint=17,24
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+c           print*,indexint,i,aux2(i),aux1(i),aux3(i),aux4(i)
+           jfotsout(indexint,1,i) = aux1(nz-i+1)
+           if(indexint.eq.24) then
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+             jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+           else 
+             jfotsout(indexint,1,i)=0.
+           end if
+           end if
+c           print*,indexint,i,(jfotsout(indexint,j,i),j=1,nabs)
+         enddo
+      end do
+
+
+c************************************************
+c     o2,90.9,119.5
+c************************************************
+      
+      do indexint=17,24
+         do i=1,nz
+            aux2(nz-i+1) = o2colx(i) + co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,2,i) = aux1(nz-i+1)
+            if(indexint.eq.24) then
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,2,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,2,i)=0.
+               end if
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      co2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+            else
+               jfotsout(indexint,1,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      o2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,2,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,2,i)=0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      h2o,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,4,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,4,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,4,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c      h2o2,119.6,202.5
+c************************************************
+
+      do indexint=25,31
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i) + o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = c12(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,6,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c************************************************
+c     co2,202.6,210.0
+c************************************************
+
+      indexint=32
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
+            aux4(i) = c1(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nz-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
+     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+            else
+               jfotsout(indexint,1,i)=0.
+            end if
+         enddo
+
+
+c************************************************
+c     h2o2,202.6,210.0
+c************************************************
+
+      indexint=32
+         do i=1,nz
+            aux2(nz-i+1) = co2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = c1(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,6,i)=0.
+            end if
+         enddo
+
+
+c************************************************
+c     h2o2,210.1,337.5
+c************************************************
+
+      indexint=33
+      limdown=1.e-20
+      limup=1e25
+         do i=1,nz
+            aux2(nz-i+1) = h2o2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
+            aux4(i) = ch2o2(nz2-i+1)
+         enddo
+         call interpfast 
+     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
+         do i=1,nz
+            jfotsout(indexint,6,i) = aux1(nz-i+1)
+         enddo
+
+      return
+
+      end
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiff.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiff.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiff.F	(revision 46)
@@ -0,0 +1,610 @@
+      subroutine moldiff(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
+     &                   zzlay,pdteuv,pdtconduc,pdqdiff)
+
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+
+c
+c Input/Output
+c
+      real ptimestep
+      real pplay(ngridmx,nlayermx)
+      real zzlay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      real pq(ngridmx,nlayermx,nqmx)
+      real pdq(ngridmx,nlayermx,nqmx)
+      real pt(ngridmx,nlayermx)
+      real pdt(ngridmx,nlayermx)
+      real pdteuv(ngridmx,nlayermx)
+      real pdtconduc(ngridmx,nlayermx)
+      real pdqdiff(ngridmx,nlayermx,nqmx)
+c
+c Local
+c
+       real hco2(ncomptot),ho
+
+      integer ig,nz,l,n,nn,iq
+      real del1,del2, tmean ,dalfinvdz, d
+      real hh,dcoef,dcoef1,ptfac, ntot, dens, dens2, dens3
+      real hp(nlayermx)
+      real tt(nlayermx)
+      real qq(nlayermx,ncomptot)
+      real dmmeandz(nlayermx)
+      real qnew(nlayermx,ncomptot)
+      real zlocal(nlayermx)
+      real alf(ncomptot-1,ncomptot-1)
+      real alfinv(nlayermx,ncomptot-1,ncomptot-1)
+      real indx(ncomptot-1)
+      real b(nlayermx,ncomptot-1)
+      real y(ncomptot-1,ncomptot-1)
+      real aa(nlayermx,ncomptot-1,ncomptot-1)
+      real bb(nlayermx,ncomptot-1,ncomptot-1)
+      real cc(nlayermx,ncomptot-1,ncomptot-1)
+      real atri(nlayermx-2)
+      real btri(nlayermx-2)
+      real ctri(nlayermx-2)
+      real rtri(nlayermx-2)
+      real qtri(nlayermx-2)
+      real alfdiag(ncomptot-1)
+      real wi(ncomptot), flux(ncomptot), pote
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the molecular diffusion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c  Atomic oxygen must always be the LAST species of the list as
+c it is the dominant species at high altitudes. 
+      integer,parameter :: i_co   = 1
+      integer,parameter :: i_n2   = 2
+      integer,parameter :: i_o2   = 3
+      integer,parameter :: i_co2  = 4
+      integer,parameter :: i_h2   = 5
+      integer,parameter :: i_h    = 6
+      integer,parameter :: i_oh   = 7
+      integer,parameter :: i_ho2  = 8
+      integer,parameter :: i_h2o  = 9
+      integer,parameter :: i_h2o2 = 10
+      integer,parameter :: i_o1d  = 11
+      integer,parameter :: i_o3   = 12
+      integer,parameter :: i_ar   = 13
+      integer,parameter :: i_o    = 14
+
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_ar=0
+      integer,save :: g_h2o=0
+
+      integer,save :: gcmind(ncomptot) ! array of GCM indexes
+      integer ierr
+
+      logical,save :: firstcall=.true.
+      real abfac(ncomptot)
+      real,save :: dij(ncomptot,ncomptot)
+
+! Initializations at first call
+      if (firstcall) then
+        call moldiffcoeff(dij)
+        print*,'MOLDIFF  EXO'
+        
+        ! identify the indexes of the tracers we'll need
+        g_co2=igcm_co2
+        if (g_co2.eq.0) then
+          write(*,*) "moldiff: Error; no CO2 tracer !!!"
+          stop
+        endif
+        g_co=igcm_co
+        if (g_co.eq.0) then
+          write(*,*) "moldiff: Error; no CO tracer !!!"
+          stop
+        endif
+        g_o=igcm_o
+        if (g_o.eq.0) then
+          write(*,*) "moldiff: Error; no O tracer !!!"
+          stop
+        endif
+        g_o1d=igcm_o1d
+        if (g_o1d.eq.0) then
+          write(*,*) "moldiff: Error; no O1D tracer !!!"
+          stop
+        endif
+        g_o2=igcm_o2
+        if (g_o2.eq.0) then
+          write(*,*) "moldiff: Error; no O2 tracer !!!"
+          stop
+        endif
+        g_o3=igcm_o3
+        if (g_o3.eq.0) then
+          write(*,*) "moldiff: Error; no O3 tracer !!!"
+          stop
+        endif
+        g_h=igcm_h
+        if (g_h.eq.0) then
+          write(*,*) "moldiff: Error; no H tracer !!!"
+          stop
+        endif
+        g_h2=igcm_h2
+        if (g_h2.eq.0) then
+          write(*,*) "moldiff: Error; no H2 tracer !!!"
+          stop
+        endif
+        g_oh=igcm_oh
+        if (g_oh.eq.0) then
+          write(*,*) "moldiff: Error; no OH tracer !!!"
+          stop
+        endif
+        g_ho2=igcm_ho2
+        if (g_ho2.eq.0) then
+          write(*,*) "moldiff: Error; no HO2 tracer !!!"
+          stop
+        endif
+        g_h2o2=igcm_h2o2
+        if (g_h2o2.eq.0) then
+          write(*,*) "moldiff: Error; no H2O2 tracer !!!"
+          stop
+        endif
+        g_n2=igcm_n2
+        if (g_n2.eq.0) then
+          write(*,*) "moldiff: Error; no N2 tracer !!!"
+          stop
+        endif
+        g_ar=igcm_ar
+        if (g_ar.eq.0) then
+          write(*,*) "moldiff: Error; no AR tracer !!!"
+          stop
+        endif
+        g_h2o=igcm_h2o_vap
+        if (g_h2o.eq.0) then
+          write(*,*) "moldiff: Error; no water vapor tracer !!!"
+          stop
+        endif
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c   fill array to relate local indexes to gcm indexes
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+        gcmind(i_co)	= g_co
+        gcmind(i_n2)	= g_n2
+        gcmind(i_o2)	= g_o2
+        gcmind(i_co2)	= g_co2
+        gcmind(i_h2)	= g_h2
+        gcmind(i_h)	= g_h
+        gcmind(i_oh)	= g_oh
+        gcmind(i_ho2)	= g_ho2
+        gcmind(i_h2o)	= g_h2o
+        gcmind(i_h2o2)  = g_h2o2
+        gcmind(i_o1d)   = g_o1d
+        gcmind(i_o3)    = g_o3
+        gcmind(i_o)     = g_o
+        gcmind(i_ar)    = g_ar
+
+        firstcall= .false.
+      endif ! of if (firstcall)
+
+
+
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      nz=nlayermx
+
+      do ig=1,ngridmx
+
+        do l=2,nz-1
+          tt(l)=pt(ig,l)+pdt(ig,l)*ptimestep
+     &                  +pdteuv(ig,l)*ptimestep
+     &                  +pdtconduc(ig,l)*ptimestep
+
+          do nn=1,ncomptot
+            qq(l,nn)=pq(ig,l,gcmind(nn))+pdq(ig,l,gcmind(nn))*ptimestep
+            qq(l,nn)=max(qq(l,nn),1.e-30)
+          enddo
+          hp(l)=-log(pplay(ig,l+1)/pplay(ig,l-1))
+          dmmeandz(l)=(mmean(ig,l+1)-mmean(ig,l-1))/hp(l)
+        enddo
+
+        tt(1)=pt(ig,1)  +pdt(ig,1)*ptimestep
+     &                  +pdteuv(ig,1)*ptimestep
+     &                  +pdtconduc(ig,1)*ptimestep
+        tt(nz)=pt(ig,nz)+pdt(ig,nz)*ptimestep
+     &                  +pdteuv(ig,nz)*ptimestep
+     &                  +pdtconduc(ig,nz)*ptimestep
+
+        do nn=1,ncomptot
+          qq(1,nn)=pq(ig,1,gcmind(nn))+pdq(ig,1,gcmind(nn))*ptimestep
+          qq(nz,nn)=pq(ig,nz,gcmind(nn))+pdq(ig,nz,gcmind(nn))*ptimestep
+          qq(1,nn)=max(qq(1,nn),1.e-30)
+          qq(nz,nn)=max(qq(nz,nn),1.e-30)
+        enddo
+        hp(1)=-log(pplay(ig,2)/pplay(ig,1))
+        dmmeandz(1)=(-3.*mmean(ig,1)+4.*mmean(ig,2)
+     &               -mmean(ig,3))/(2.*hp(1))
+        hp(nz)=-log(pplay(ig,nz)/pplay(ig,nz-1))
+        dmmeandz(nz)=(3.*mmean(ig,nz)-4.*mmean(ig,nz-1)
+     &                +mmean(ig,nz-2))/(2.*hp(nz))
+c
+c Setting-up matrix of alfa coefficients from Dickinson and Ridley 1972
+c
+      do l=1,nz
+       if(abs(dmmeandz(l)) .lt. 1.e-5) dmmeandz(l)=0.0
+        hh=rnew(ig,l)*tt(l)/g
+        ptfac=(1.e5/pplay(ig,l))*(tt(l)/273)**1.75
+        ntot=pplay(ig,l)/(1.381e-23*tt(l))      		! in #/m3
+
+        do nn=1,ncomptot-1            ! rows
+          alfdiag(nn)=0.
+          dcoef1=dij(nn,i_o)*ptfac
+          do n=1,ncomptot-1           ! columns
+            y(nn,n)=0.
+            dcoef=dij(nn,n)*ptfac
+            alf(nn,n)=qq(l,nn)/ntot/1.66e-27
+     &         *(1./(mmol(gcmind(n))*dcoef)-1./(mmol(g_o)*dcoef1))
+            alfdiag(nn)=alfdiag(nn)
+     &       +(1./(mmol(gcmind(n))*dcoef)-1./(mmol(g_o)*dcoef1))
+     &        *qq(l,n)
+          enddo
+          dcoef=dij(nn,nn)*ptfac
+          alfdiag(nn)=alfdiag(nn)
+     &       -(1./(mmol(gcmind(nn))*dcoef)-1./(mmol(g_o)*dcoef1))
+     &          *qq(l,nn)
+          alf(nn,nn)=-(alfdiag(nn)
+     &                 +1./(mmol(g_o)*dcoef1))/ntot/1.66e-27
+          y(nn,nn)=1.
+          b(l,nn)=-(dmmeandz(l)/mmean(ig,l)
+     &              +mmol(gcmind(nn))/mmean(ig,l)-1.)
+        enddo
+
+c
+c Inverting the alfa matrix
+c
+        call ludcmp(alf,ncomptot-1,ncomptot-1,indx,d,ierr)
+
+c       TEMPORAIRE *****************************
+        if (ierr.ne.0) then
+            write(*,*) 'In moldiff: Problem in LUDCMP with matrix alf'
+            write(*,*) 'Singular matrix ?'
+c           write(*,*) 'Matrix alf = ', alf
+            write(*,*) 'ig, l=',ig, l
+            write(*,*) 'No molecular diffusion this time !'
+            call zerophys(ngridmx*nlayermx*nqmx,pdqdiff)
+            return
+c           stop
+        end if
+c       *******************************************
+        do n=1,ncomptot-1
+          call lubksb(alf,ncomptot-1,ncomptot-1,indx,y(1,n))
+          do nn=1,ncomptot-1
+            alfinv(l,nn,n)=y(nn,n)/hh
+          enddo
+        enddo
+      enddo
+
+c
+c Calculating coefficients of the system
+c
+
+c      zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))* Rnew(ig,1)*tt(1)/g
+      zlocal(1)=zzlay(ig,1)
+
+      do l=2,nz-1
+        del1=hp(l)*pplay(ig,l)/(g*ptimestep)
+        del2=(hp(l)/2)**2*pplay(ig,l)/(g*ptimestep)
+        do nn=1,ncomptot-1
+          do n=1,ncomptot-1
+            dalfinvdz=(alfinv(l+1,nn,n)-alfinv(l-1,nn,n))/hp(l)
+            aa(l,nn,n)=-dalfinvdz/del1+alfinv(l,nn,n)/del2
+     &                +alfinv(l-1,nn,n)*b(l-1,n)/del1    
+            bb(l,nn,n)=-2.*alfinv(l,nn,n)/del2
+            cc(l,nn,n)=dalfinvdz/del1+alfinv(l,nn,n)/del2
+     &                -alfinv(l+1,nn,n)*b(l+1,n)/del1    
+          enddo
+        enddo
+
+c        tmean=tt(l)
+c        if(tt(l).ne.tt(l-1))
+c     &        tmean=(tt(l)-tt(l-1))/log(tt(l)/tt(l-1))
+c        zlocal(l)= zlocal(l-1)
+c     &         -log(pplay(ig,l)/pplay(ig,l-1))*rnew(ig,l)*tmean/g
+      zlocal(l)=zzlay(ig,l)
+      enddo 
+
+c      zlocal(nz)= zlocal(nz-1)
+c     &         -log(pplay(ig,nz)/pplay(ig,nz-1))*rnew(ig,nz)*tmean/g
+      zlocal(nz)=zzlay(ig,nz)
+        
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Escape velocity from Jeans equation for the flux of H and H2
+c (Hunten 1973, eq. 5)
+      
+      do n=1,ncomptot
+        wi(n)=1.
+        flux(n)=0.
+        abfac(n)=1.
+      enddo
+
+       dens=pplay(ig,nz)/(rnew(ig,nz)*tt(nz))
+c
+c For H:
+c
+       pote=(3398000.+zlocal(nz))/
+     &         (1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h)*g))
+       wi(i_h)=sqrt(2.*1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h)))
+     &             /(2.*sqrt(3.1415))*(1.+pote)*exp(-pote)
+       flux(i_h)=qq(nz,i_h)*dens/(1.6605e-27*mmol(g_h))*wi(i_h)
+       flux(i_h)=flux(i_h)*1.6606e-27
+       abfac(i_h)=0.
+c
+c For H2:
+c
+       pote=(3398000.+zlocal(nz))/
+     &         (1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h2)*g))
+       wi(i_h2)=sqrt(2.*1.381e-23*tt(nz)/(1.6605e-27*mmol(g_h2)))
+     &              /(2.*sqrt(3.1415))*(1.+pote)*exp(-pote)
+       flux(i_h2)=qq(nz,i_h2)*dens/(1.6605e-27*mmol(g_h2))*wi(i_h2)
+       flux(i_h2)=flux(i_h2)*1.6606e-27
+       abfac(i_h2)=0.
+
+c ********* TEMPORAIRE : no escape for h and h2
+c     do n=1,ncomptot
+c       wi(n)=1.
+c       flux(n)=0.
+c       abfac(n)=1.
+c     enddo
+c ********************************************
+
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c
+c Setting coefficients for tridiagonal matrix and solving the system
+c
+
+      do nn=1,ncomptot-1
+        do l=2,nz-1
+          atri(l-1)=aa(l,nn,nn)
+          btri(l-1)=bb(l,nn,nn)+1.
+          ctri(l-1)=cc(l,nn,nn)
+          rtri(l-1)=qq(l,nn)
+          do n=1,ncomptot-1
+            rtri(l-1)=rtri(l-1)-(aa(l,nn,n)*qq(l-1,n)
+     &                           +bb(l,nn,n)*qq(l,n)
+     &                           +cc(l,nn,n)*qq(l+1,n))
+          enddo
+          rtri(l-1)=rtri(l-1)+(aa(l,nn,nn)*qq(l-1,nn)
+     &                         +bb(l,nn,nn)*qq(l,nn)
+     &                         +cc(l,nn,nn)*qq(l+1,nn))
+        enddo
+
+c
+c Boundary conditions:
+c	Escape flux for H and H2 at top
+c	Diffusive equilibrium for the other species at top
+c	Perfect mixing for all at bottom
+c
+
+        rtri(nz-2)=rtri(nz-2)
+     &             -ctri(nz-2)*flux(nn)*mmol(gcmind(nn))/(dens*wi(nn))
+
+        atri(nz-2)=atri(nz-2)
+     &             -abfac(nn)*ctri(nz-2)/(3.-2.*hp(nz)*b(nz,nn))
+        btri(nz-2)=btri(nz-2)
+     &             +abfac(nn)*4.*ctri(nz-2)/(3.-2.*hp(nz)*b(nz,nn))
+
+c        rtri(1)=rtri(1)-atri(1)*qq(1,nn)
+        btri(1)=btri(1)+atri(1)
+
+        call tridag(atri,btri,ctri,rtri,qtri,nz-2)
+
+        do l=2,nz-1
+c          qnew(l,nn)=qtri(l-1)
+          qnew(l,nn)=max(qtri(l-1),1.e-30)
+        enddo
+
+        qnew(nz,nn)=flux(nn)*mmol(gcmind(nn))/(dens*wi(nn))
+     &               +abfac(nn)*(4.*qnew(nz-1,nn)-qnew(nz-2,nn))
+     &                /(3.-2.*hp(nz)*b(nz,nn))
+c        qnew(1,nn)=qq(1,nn)
+        qnew(1,nn)=qnew(2,nn)
+         
+        qnew(nz,nn)=max(qnew(nz,nn),1.e-30)
+        qnew(1,nn)=max(qnew(1,nn),1.e-30)
+
+      enddo 	! loop on species
+
+      DO l=1,nz
+        if(zlocal(l).gt.65000.)then
+        pdqdiff(ig,l,g_o)=0.
+        do n=1,ncomptot-1
+          pdqdiff(ig,l,gcmind(n))=(qnew(l,n)-qq(l,n))
+          pdqdiff(ig,l,g_o)=pdqdiff(ig,l,g_o)-(qnew(l,n)-qq(l,n))
+          pdqdiff(ig,l,gcmind(n))=pdqdiff(ig,l,gcmind(n))/ptimestep
+        enddo
+		pdqdiff(ig,l,g_o)=pdqdiff(ig,l,g_o)/ptimestep
+        endif
+      ENDDO
+
+c      do l=2,nz
+c        do n=1,ncomptot-1
+c          hco2(n)=qnew(l,n)*pplay(ig,l)/(rnew(ig,l)*tt(l)) /
+c     &      (qnew(l-1,n)*pplay(ig,l-1)/(rnew(ig,l-1)*tt(l-1))) 
+c          hco2(n)=-(zlocal(l)-zlocal(l-1))/log(hco2(n))/1000.
+c        enddo
+c        write(225,*),l,pt(1,l),(hco2(n),n=1,6)
+c        write(226,*),l,pt(1,l),(hco2(n),n=7,12)
+c      enddo
+
+      enddo		! ig loop
+
+      return
+      end
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+ 
+      subroutine tridag(a,b,c,r,u,n)
+      parameter (nmax=100)
+c      dimension gam(nmax),a(n),b(n),c(n),r(n),u(n)
+      real gam(nmax),a(n),b(n),c(n),r(n),u(n)
+      if(b(1).eq.0.)then
+        stop 'tridag: error: b(1)=0 !!! '
+      endif
+      bet=b(1)
+      u(1)=r(1)/bet
+      do 11 j=2,n
+        gam(j)=c(j-1)/bet
+        bet=b(j)-a(j)*gam(j)
+        if(bet.eq.0.) then
+          stop 'tridag: error: bet=0 !!! '
+        endif
+        u(j)=(r(j)-a(j)*u(j-1))/bet
+11    continue
+      do 12 j=n-1,1,-1
+        u(j)=u(j)-gam(j+1)*u(j+1)
+12    continue
+      return
+      end
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+
+      SUBROUTINE LUBKSB(A,N,NP,INDX,B)
+
+      implicit none
+
+      integer i,j,n,np,ii,ll
+      real sum
+      real a(np,np),indx(np),b(np)
+
+c      DIMENSION A(NP,NP),INDX(N),B(N)
+      II=0
+      DO 12 I=1,N
+        LL=INDX(I)
+        SUM=B(LL)
+        B(LL)=B(I)
+        IF (II.NE.0)THEN
+          DO 11 J=II,I-1
+            SUM=SUM-A(I,J)*B(J)
+11        CONTINUE
+        ELSE IF (SUM.NE.0.) THEN
+          II=I
+        ENDIF
+        B(I)=SUM
+12    CONTINUE
+      DO 14 I=N,1,-1
+        SUM=B(I)
+        IF(I.LT.N)THEN
+          DO 13 J=I+1,N
+            SUM=SUM-A(I,J)*B(J)
+13        CONTINUE
+        ENDIF
+        B(I)=SUM/A(I,I)
+14    CONTINUE
+      RETURN
+      END
+
+c    ********************************************************************
+c    ********************************************************************
+c    ********************************************************************
+
+      SUBROUTINE LUDCMP(A,N,NP,INDX,D,ierr)
+
+      implicit none
+
+      integer n,np,nmax,i,j,k,imax
+      real d,tiny,aamax
+      real a(np,np),indx(np)
+      integer ierr  ! error =0 if OK, =1 if problem
+
+      PARAMETER (NMAX=100,TINY=1.0E-20)
+c      DIMENSION A(NP,NP),INDX(N),VV(NMAX)
+      real sum,vv(nmax),dum
+
+      D=1.
+      DO 12 I=1,N
+        AAMAX=0.
+        DO 11 J=1,N
+          IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
+11      CONTINUE
+        IF (AAMAX.EQ.0.) then
+            write(*,*) 'In moldiff: Problem in LUDCMP with matrix A'
+            write(*,*) 'Singular matrix ?'
+c           write(*,*) 'Matrix A = ', A
+c           TO DEBUG :
+            ierr =1
+            return
+c           stop
+        END IF 
+
+        VV(I)=1./AAMAX
+12    CONTINUE
+      DO 19 J=1,N
+        IF (J.GT.1) THEN
+          DO 14 I=1,J-1
+            SUM=A(I,J)
+            IF (I.GT.1)THEN
+              DO 13 K=1,I-1
+                SUM=SUM-A(I,K)*A(K,J)
+13            CONTINUE
+              A(I,J)=SUM
+            ENDIF
+14        CONTINUE
+        ENDIF
+        AAMAX=0.
+        DO 16 I=J,N
+          SUM=A(I,J)
+          IF (J.GT.1)THEN
+            DO 15 K=1,J-1
+              SUM=SUM-A(I,K)*A(K,J)
+15          CONTINUE
+            A(I,J)=SUM
+          ENDIF
+          DUM=VV(I)*ABS(SUM)
+          IF (DUM.GE.AAMAX) THEN
+            IMAX=I
+            AAMAX=DUM
+          ENDIF
+16      CONTINUE
+        IF (J.NE.IMAX)THEN
+          DO 17 K=1,N
+            DUM=A(IMAX,K)
+            A(IMAX,K)=A(J,K)
+            A(J,K)=DUM
+17        CONTINUE
+          D=-D
+          VV(IMAX)=VV(J)
+        ENDIF
+        INDX(J)=IMAX
+        IF(J.NE.N)THEN
+          IF(A(J,J).EQ.0.)A(J,J)=TINY
+          DUM=1./A(J,J)
+          DO 18 I=J+1,N
+            A(I,J)=A(I,J)*DUM
+18        CONTINUE
+        ENDIF
+19    CONTINUE
+      IF(A(N,N).EQ.0.)A(N,N)=TINY
+      ierr =0
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiffcoeff.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiffcoeff.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/moldiffcoeff.F	(revision 46)
@@ -0,0 +1,217 @@
+      subroutine moldiffcoeff(dij)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing molecular diffusion coefficients
+c   following Nair 94 (pg 131)
+c   author:  MAC 2002
+c   ------
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      real dij(ncomptot,ncomptot)
+
+c    Local variables:
+c    ---------------
+      INTEGER nq, n, nn, i,iq
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the molecular diffusion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c  Atomic oxygen must always be the LAST species of the list as
+c it is the dominant species at high altitudes. 
+      integer,parameter :: i_co   = 1
+      integer,parameter :: i_n2   = 2
+      integer,parameter :: i_o2   = 3
+      integer,parameter :: i_co2  = 4
+      integer,parameter :: i_h2   = 5
+      integer,parameter :: i_h    = 6
+      integer,parameter :: i_oh   = 7
+      integer,parameter :: i_ho2  = 8
+      integer,parameter :: i_h2o  = 9
+      integer,parameter :: i_h2o2 = 10
+      integer,parameter :: i_o1d  = 11
+      integer,parameter :: i_o3   = 12
+      integer,parameter :: i_ar   = 13
+      integer,parameter :: i_o    = 14
+
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_ar=0
+      integer,save :: g_h2o=0
+
+      integer,save :: gcmind(ncomptot)
+
+      real dnh
+      logical,save :: firstcall=.true.
+
+! Initializations at first call (and some sanity checks)
+      if (firstcall) then
+        ! identify the indexes of the tracers we'll need
+        g_co2=igcm_co2
+        if (g_co2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no CO2 tracer !!!"
+          stop
+        endif
+        g_co=igcm_co
+        if (g_co.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no CO tracer !!!"
+          stop
+        endif
+        g_o=igcm_o
+        if (g_o.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no O tracer !!!"
+          stop
+        endif
+        g_o1d=igcm_o1d
+        if (g_o1d.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no O1D tracer !!!"
+          stop
+        endif
+        g_o2=igcm_o2
+        if (g_o2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no O2 tracer !!!"
+          stop
+        endif
+        g_o3=igcm_o3
+        if (g_o3.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no O3 tracer !!!"
+          stop
+        endif
+        g_h=igcm_h
+        if (g_h.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no H tracer !!!"
+          stop
+        endif
+        g_h2=igcm_h2
+        if (g_h2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no H2 tracer !!!"
+          stop
+        endif
+        g_oh=igcm_oh
+        if (g_oh.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no OH tracer !!!"
+          stop
+        endif
+        g_ho2=igcm_ho2
+        if (g_ho2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no HO2 tracer !!!"
+          stop
+        endif
+        g_h2o2=igcm_h2o2
+        if (g_h2o2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no H2O2 tracer !!!"
+          stop
+        endif
+        g_n2=igcm_n2
+        if (g_n2.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no N2 tracer !!!"
+          stop
+        endif
+        g_ar=igcm_ar
+        if (g_ar.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no AR tracer !!!"
+          stop
+        endif
+        g_h2o=igcm_h2o_vap
+        if (g_h2o.eq.0) then
+          write(*,*) "moldiffcoeff: Error; no water vapor tracer !!!"
+          stop
+        endif
+
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c    fill array to relate local indexes to gcm indexes
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+        gcmind(i_co)  =   g_co
+        gcmind(i_n2)  =   g_n2
+        gcmind(i_o2)  =   g_o2
+        gcmind(i_co2) =   g_co2
+        gcmind(i_h2)  =   g_h2
+        gcmind(i_h)   =   g_h
+        gcmind(i_oh)  =   g_oh
+        gcmind(i_ho2) =   g_ho2
+        gcmind(i_h2o) =   g_h2o
+        gcmind(i_h2o2)=   g_h2o2
+        gcmind(i_o1d) =   g_o1d
+        gcmind(i_o3)  =   g_o3
+        gcmind(i_o)   =   g_o
+        gcmind(i_ar)   =  g_ar
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+        firstcall= .false.
+      endif ! of if (firstcall)
+
+
+      dij(i_h2,i_co)   = 0.0000651
+      dij(i_h2,i_n2)   = 0.0000674
+      dij(i_h2,i_o2)   = 0.0000697
+      dij(i_h2,i_co2)  = 0.0000550
+      dij(i_h2,i_h2)   = 0.0
+      dij(i_h2,i_h)    = 0.0
+      dij(i_h2,i_oh)   = 0.0	!0003
+      dij(i_h2,i_ho2)  = 0.0	!0003
+      dij(i_h2,i_h2o)  = 0.0	!0003
+      dij(i_h2,i_h2o2) = 0.0	!0003
+      dij(i_h2,i_o1d)  = 0.0
+      dij(i_h2,i_o3)   = 0.0	!0003
+      dij(i_h2,i_o)    = 0.0
+      dij(i_h2,i_ar)   = 0.0
+
+c      dij(i_h,i_o)     = 0.0000144
+      dij(i_h,i_o)     = 0.000114
+
+       print*,'moldiffcoef: COEFF CALC'
+       open(56,file='coeffs.dat',status='unknown')
+      do n=1,ncomptot
+        if (dij(i_h2,n).gt.0.0) then
+          do nn=n,ncomptot
+            dij(nn,n)=dij(i_h2,n)
+     &                  *sqrt(mmol(g_h2)/mmol(gcmind(nn)))
+            if(n.eq.nn) dij(nn,n)=1.0
+            dij(n,nn)=dij(nn,n)
+          enddo 
+        endif
+        if (dij(i_h2,n).eq.0.0) then
+          dnh=dij(i_h,i_o)*sqrt(mmol(g_o)/mmol(gcmind(n)))
+          do nn=n,ncomptot
+            dij(nn,n)=dnh*sqrt(mmol(g_h)/mmol(gcmind(nn)))
+            if(n.eq.nn) dij(nn,n)=1.0
+            dij(n,nn)=dij(nn,n)
+          enddo 
+        endif
+      enddo 
+
+      do n=1,ncomptot
+        do nn=n,ncomptot
+          write(56,*) n,nn,dij(n,nn)	!*1.e5/1.381e-23/(273**1.75)
+        enddo
+      enddo
+      close(56)
+
+
+      return   
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/molvis.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/molvis.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/molvis.F	(revision 46)
@@ -0,0 +1,196 @@
+       SUBROUTINE molvis(ptimestep,pplay,pplev,pt,pdteuv,pdtconduc,pvel,
+     $                   tsurf,zzlev,zzlay,zdvelmolvis)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Molecular Viscosity Diffusion
+c  
+c   Based on conduction.F  by N. Descamp, F. Forget 05/1999
+c
+c   modified by M. Angelats i Coll
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+c   arguments:
+c   ----------
+
+      REAL ptimestep
+      REAL pplay(ngridmx,nlayermx)
+      REAL pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      REAL zzlev(ngridmx,nlayermx+1)
+      real pt(ngridmx,nlayermx)
+      real tsurf(ngridmx)
+      REAL pvel(ngridmx,nlayermx)
+      REAL pdvel(ngridmx,nlayermx)
+      real pdteuv(ngridmx,nlayermx)
+      real pdtconduc(ngridmx,nlayermx)
+
+      real zdvelmolvis(ngridmx,nlayermx)
+
+c   local:
+c   ------
+
+      INTEGER l,ig, ngrid,nz
+      real Akk,skk,phitop,velsurf,fac, m, tmean
+      REAL zvel(nlayermx)
+      real zt(nlayermx)
+      REAL alpha(nlayermx)
+      REAL lambda(nlayermx)
+      real muvol(nlayermx)
+      REAL C(nlayermx)
+      real D(nlayermx)
+      real den(nlayermx)
+      REAL pdvelm(nlayermx)
+      REAL zlay(nlayermx)
+      real zlev(nlayermx+1)
+
+c   constants used locally
+c    ---------------------
+c     The atmospheric conductivity is a function of temperature T :
+c      conductivity = Akk* T**skk
+c     Molecular viscosity is related to thermal conductivity by:
+c       conduc = 0.25*(9*gamma - 5)* Cv * molvis
+c     where gamma = Cp/Cv.  For dry air.
+
+
+      PARAMETER (skk=0.69)
+
+      PARAMETER (velsurf =0.0)
+      
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+c-----------------------------------------------------------------------
+c   calcul des coefficients alpha et lambda
+c-----------------------------------------------------------------------
+
+      IF (firstcall) THEN
+!        write(*,*)'molvis: coeff of molecular viscosity Akk,skk,factor'
+!        write(*,*) Akk,skk,fac
+! NB: Akk and fac are undefined at firstcall
+        write(*,*)'molvis: coeff of molecular viscosity skk ', skk
+        
+        firstcall = .false.
+      END IF
+
+! Initialize phitop
+      phitop=0.0
+
+      ngrid=ngridmx
+      nz=nlayermx
+
+      do ig=1,ngrid
+
+        zt(1)=pt(ig,1)+(pdteuv(ig,1)+pdtconduc(ig,1))*ptimestep
+        zvel(1)=pvel(ig,1)
+c        zlay(1)=-log(pplay(ig,1)/pplev(ig,1))*Rnew(ig,1)*zt(1)/g
+c        zlev(1)=0.0
+
+        zlay(1)=zzlay(ig,1)
+        zlev(1)=zzlev(ig,1)
+
+        do l=2,nz
+          zt(l)=pt(ig,l)+(pdteuv(ig,l)+pdtconduc(ig,l))*ptimestep
+          zvel(l)=pvel(ig,l)
+c          tmean=zt(l)
+c          if(zt(l).ne.zt(l-1)) tmean=(zt(l)-zt(l-1))/log(zt(l)/zt(l-1))
+c          zlay(l)= zlay(l-1)
+c     &          -log(pplay(ig,l)/pplay(ig,l-1))*Rnew(ig,l-1)*tmean/g
+c          zlev(l)= zlev(l-1)
+c     &         -log(pplev(ig,l)/pplev(ig,l-1))*Rnew(ig,l-1)*tmean/g
+        zlay(l)=zzlay(ig,l)
+        zlev(l)=zzlev(ig,l)
+        enddo
+
+c          zlev(nz+1)= zlev(nz)
+c     &         -log(max(pplev(ig,nz+1),1.e-30)/pplev(ig,nz))
+c     &          *Rnew(ig,nz)*tmean/g
+c          if(pplev(ig,nz+1).eq.0.)
+c     &       zlev(nz+1)=zlev(nz)+(zlay(nz)-zlay(nz-1))
+
+          zlev(nz+1)= zlev(nz)+10000.
+
+        fac=0.25*(9.*cpnew(ig,1)-5.*(cpnew(ig,1)-rnew(ig,1))) 
+        Akk=Akknew(ig,1)
+        lambda(1)=Akk*tsurf(ig)**skk/zlay(1)/fac   
+c        write(*,*) 'rnew(ig,nz)  ',ig , rnew(ig,nz)
+
+        DO l=2,nz
+          fac=(9.*cpnew(ig,l)-5.*(cpnew(ig,l)-rnew(ig,l)))/4. 
+          Akk=Akknew(ig,l)
+          lambda(l)=Akk/fac*zt(l)**skk/(zlay(l)-zlay(l-1)) 
+        ENDDO
+    
+        DO l=1,nz-1
+          muvol(l)=pplay(ig,l)/(rnew(ig,l)*zt(l)) 
+          alpha(l)=(muvol(l)/ptimestep)*(zlev(l+1)-zlev(l))
+        ENDDO
+        muvol(nz)=pplay(ig,nz)/(rnew(ig,nz)*zt(nz)) 
+        alpha(nz)=(muvol(nz)/ptimestep)*(zlev(nz+1)-zlev(nz))
+
+c--------------------------------------------------------------------
+c
+c     calcul des coefficients C et D
+c
+c-------------------------------------------------------------------
+
+      den(1)=alpha(1)+lambda(2)+lambda(1)
+      C(1)=lambda(1)*(velsurf-zvel(1))+lambda(2)*(zvel(2)-zvel(1))
+      C(1)=C(1)/den(1)	     
+      D(1)=lambda(2)/den(1)           
+   
+      DO l = 2,nz-1
+         den(l)=alpha(l)+lambda(l+1)
+         den(l)=den(l)+lambda(l)*(1-D(l-1))
+         
+         C(l) =lambda(l+1)*(zvel(l+1)-zvel(l)) 
+     $        +lambda(l)*(zvel(l-1)-zvel(l)+C(l-1))    
+         C(l) =C(l)/den(l)           
+
+         D(l) =lambda(l+1) / den(l)
+      ENDDO 
+
+      den(nz)=alpha(nz) + lambda(nz) * (1-D(nz-1))
+      C(nz)=C(nz-1)+zvel(nz-1)-zvel(nz) 
+      C(nz)=(C(nz)*lambda(nz)+phitop) / den(nz) 
+       	 	
+c----------------------------------------------------------------------
+c
+c      calcul de la nouvelle pdvelm 
+c
+c----------------------------------------------------------------------
+
+      DO l=1,nz
+         pdvelm(l)=0.
+      ENDDO
+         pdvelm(nz)=C(nz)
+      DO l=nz-1,1,-1
+         pdvelm(l)=C(l)+D(l)*pdvelm(l+1)
+      ENDDO 
+c-----------------------------------------------------------------------
+c
+c     calcul de la tendance zdvelmolvis
+c
+c-----------------------------------------------------------------------
+    
+      DO l=1,nz
+        zdvelmolvis(ig,l)=pdvelm(l)/ptimestep
+      ENDDO
+
+      ENDDO             ! boucle sur ngrid
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/param_read.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/param_read.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/param_read.F	(revision 46)
@@ -0,0 +1,233 @@
+      subroutine param_read
+
+      implicit none
+
+
+c     common variables and constants
+
+#include "param.h"
+#include "param_v3.h"
+#include "datafile.h"
+
+
+c     local variables
+
+      integer    i,j,k,inter                          !indexes
+      integer ierr 
+      real       nada
+      logical,save :: firstcall=.true.
+
+     
+c*************************+PROGRAM STARTS**************************
+
+
+c     data
+      if (firstcall) then
+      anchint(:)=(/4.9,5.3,6.1,12.8,2.0,6.9,11.8,0.4,1.9,4.9,0.9,4.0,
+     $6.9,4.9,4.9,10.2,5.6,1.9,0.9,0.9,0.9,0.9,3.7
+     $,13.1,3.9,6.0,4.8,23.9,8.4,8.5,26.8,7.5,127.6/)
+
+      crscabsi2(1,1:ninter2)=(/0.0,4.42e-18,7.51e-18
+     $,1.498e-17,2.344e-17,2.388e-17,2.927E-17,3.161e-17,3.161e-17,
+     $3.4e-17,3.4e-17,2.588e-17,2.596e-17,2.248e-17,3.183e-17,
+     $1.284e-17/)
+
+      crscabsi2(2,1:ninter2)=(/2.736e-19,1.055e-18,4.789e-18
+     $,1.063e-17,1.559e-17,1.698e-17,2.164e-17,2.241e-17,2.427e-17,
+     $2.444e-17,2.502e-17,2.516e-17,2.907e-17,3.649e-17,3.066e-17,
+     $2.093e-17/)
+
+      crscabsi2(3,1:ninter2)=(/2.603e-19,6.985e-19,3.97e-18
+     $,6.621e-18,8.433e-18,9.011e-18,9.862e-18,1.033e-17,1.012e-17,
+     $1.033e-17,1.033e-17,1.034e-17,9.0e-18,3.564e-18,3.572e-18
+     $,3.47E-18/)
+
+      freccen(:)=(/3.4,7.5,14.5,23.0,30.3,34.1,49.6,50.5,52.5,56.0,
+     $59.0,61.5,68.7,73.1,78.4,83.1,92.4,97.5,99.3,100.1,100.7,102.1,
+     $104.5,116.8,121.3,127.0,130.6,153.7,162.8,171.4
+     $,195.6,206.3,273.5/)
+
+      co2crsc195(:)=(/3.691e-19,4.44216e-20,3.86945e-19,5.94208e-19,
+     $2.93217e-19,7.58769e-20,8.60192e-21,4.20007e-24,2.29996e-26/)
+
+      co2crsc295(:)=(/3.691e-19,5.21572e-20,4.23488e-19,6.54728e-19,
+     $3.30227e-19,1.03183e-19,1.55722e-20,1.72317e-23,7.0e-25/)
+      
+      firstcall=.false.
+      endif ! of if (firstcall)
+
+c     Reads tabulated functions
+
+      open(210,status='old',file=trim(datafile)//'/EUVDAT/coln.dat',
+     & iostat=ierr)
+
+      IF (ierr.NE.0) THEN
+       write(*,*)'cant find directory EUVDAT and content coln.dat'
+       write(*,*)'(in aeronomars/param_read.F)'
+       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, EUVDAT (and other datafiles)'
+       write(*,*)'   can be obtained online on:'
+       write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+       STOP
+      ENDIF
+
+      open(220,file=trim(datafile)//'/EUVDAT/j2_an.dat')
+      open(230,file=trim(datafile)//'/EUVDAT/j3_an.dat')
+      open(240,file=trim(datafile)//'/EUVDAT/j1_an.dat')
+      open(250,file=trim(datafile)//'/EUVDAT/j2_bn.dat')
+      open(260,file=trim(datafile)//'/EUVDAT/j2_cn.dat')
+      open(270,file=trim(datafile)//'/EUVDAT/j1_bn.dat')
+      open(280,file=trim(datafile)//'/EUVDAT/j1_cn.dat')
+      open(290,file=trim(datafile)//'/EUVDAT/j1_dn.dat')
+      open(150,file=trim(datafile)//'/EUVDAT/j4n.dat')
+      open(160,file=trim(datafile)//'/EUVDAT/j5n.dat')
+      open(170,file=trim(datafile)//'/EUVDAT/j6n.dat')
+
+      do i=210,290,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=150,170,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=nz2,1,-1
+        read(210,*) c23(i),(c123(j,i),j=2,ninter2),c12(i),c1(i),ch2o2(i)
+      end do
+
+      do i=nz2,1,-1
+         read(220,*) (jabsifotsint(j,2,i),j=1,ninter2)
+      end do
+      
+      do i=nz2,1,-1
+         read(230,*) (jabsifotsint(j,3,i),j=1,ninter2)
+      end do
+
+      do i=nz2,1,-1
+         read(240,*) (jabsifotsint(j,1,i),j=2,ninter2)
+      end do
+
+      do i=nz2,1,-1
+         read(250,*) (jabsifotsint(j,2,i),j=17,24)
+      end do
+
+      do i=nz2,1,-1
+         read(260,*) (jabsifotsint(j,2,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(270,*) (jabsifotsint(j,1,i),j=17,24)
+      end do
+
+      do i=nz2,1,-1
+         read(280,*) (jabsifotsint(j,1,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(290,*) jabsifotsint(32,1,i)
+      end do
+
+      do i=nz2,1,-1
+         read(160,*) (jabsifotsint(j,5,i),j=1,15)
+      end do
+
+      do i=nz2,1,-1
+         read(150,*) (jabsifotsint(j,4,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(170,*) (jabsifotsint(j,6,i),j=25,33)
+      end do
+
+      do i=210,290,10
+         close(i)
+      end do
+
+      do i=150,170,10
+         close(i)
+      end do
+
+
+c     reads t0
+
+      open(120,file=trim(datafile)//'/EUVDAT/t0.dat')
+      do i=1,201
+         read(120,*)t0(i)
+      end do
+      close(120)
+
+      open(100,file=trim(datafile)//'/EUVDAT/flujo.dat')
+      do i=1,ninter
+         read(100,*) inter,fluxtophr(i)
+      end do
+      close(100)
+
+
+      open(99,file=trim(datafile)//'/EUVDAT/varflujo.dat')
+      read(99,*)
+      do i=1,24
+         read(99,*) inter,ct1(i),p1(i),ct2(i),p2(i),nada
+      end do
+      close(99)
+
+c     eficiencias de disociacion (de Torr et al, 1979)
+
+      do inter=1,11
+         efdisco2(inter) = 0.
+         efdiso2(inter) = 0.
+      end do
+
+      do inter=1,15
+         efdish2(inter) = 1.
+      end do
+
+      efdisco2(12) = 0.183
+      efdiso2(12) = 0.003
+
+      efdisco2(13) = 0.163
+      efdiso2(13) = 0.170
+
+      efdisco2(14) = 0.243
+      efdiso2(14) =0.180
+
+      efdisco2(15) = 0.323
+      efdiso2(15) =0.653
+
+      efdisco2(16) = 0.235
+      efdiso2(16) =0.616
+
+      do inter=17,32
+         efdisco2(inter) = 1.0
+      end do
+
+      efdiso2(17) = 0.399
+      do inter=18,20
+         efdiso2(inter) = 0.261
+      end do
+
+      do inter=21,23
+         efdiso2(inter) = 0.755
+      end do
+
+
+      do inter=24,31
+         efdiso2(inter) = 1.
+      end do
+
+      do inter=25,31
+         efdish2o(inter) = 1.
+      end do
+
+      do inter=25,33
+         efdish2o2(inter) = 1.
+      end do
+
+
+      return
+
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/paramfoto.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/paramfoto.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/paramfoto.F	(revision 46)
@@ -0,0 +1,599 @@
+c**********************************************************************
+      
+      subroutine paramfoto
+     $(lswitch,zdens,tx,timestep,zenit,nz,co2x,o2x,o3px,cox,hx,ohx,
+     & ho2x,h2x,h2ox,h2o2x,o1dx)
+
+c     oct 2002      fgg
+c**********************************************************************
+
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c     arguments
+
+      integer nz,lswitch
+      real zdens(nz)
+      real tx(nz)
+      real co2x(nz),o2x(nz),o3px(nz),cox(nz),hx(nz),ohx(nz)
+      real    h2x(nz),h2ox(nz),h2o2x(nz),o1dx(nz),ho2x(nz)
+      real    zenit
+      real    timestep
+
+c     local variables
+
+      real*8    dt,deltat
+      integer nt, ntmax
+      real*8    tauco2(nzmax,nreact)
+      real*8    tauo2(nzmax,nreact)
+      real*8    tauo3p(nzmax,nreact)
+      real*8    tauco(nzmax,nreact)
+      real*8    tauh(nzmax,nreact)
+      real*8    tauoh(nzmax,nreact)
+      real*8    tauho2(nzmax,nreact)
+      real*8    tauh2(nzmax,nreact)
+      real*8    tauh2o(nzmax,nreact)
+      real*8    tauo1d(nzmax,nreact)
+      real*8    tauh2o2(nzmax,nreact)
+      real*8    co2x8,o2x8,o3px8,cox8,hx8,ohx8,ho2x8,h2x8,h2ox8
+      real*8    h2o2x8,o1dx8
+      real*8    o1dx8aux,ohx8aux,ho2x8aux,dif_o1d,dif_oh,dif_ho2
+      real*8    timestep8
+      real*8    jdistot8(nabs,nzmax)
+      real*8    jdistot8_b(2,nzmax)
+      real*8    tx8
+
+      real*8    tmin(nzmax)
+      integer i,j,k,nada,n
+
+      real*8    auxp,auxl
+      
+      character*1 o1d_eq(nzmax)
+      character*1 oh_eq(nzmax)
+      character*1 ho2_eq(nzmax)
+      character*1 dn
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+      if (firstcall) then
+        firstcall= .false.
+        print*,'FOTO'
+      endif
+
+c 123  format(1x,f10.7,11(tr3,e12.7))
+
+c**********************************************************************
+
+C     Start: altitude loop
+      timestep8=dble(timestep)
+
+      do i=nz,lswitch,-1
+         
+
+c     Concentrations to real*8
+
+         co2x8=dble(co2x(i))
+         o2x8=dble(o2x(i))
+         o3px8=dble(o3px(i))
+         cox8=dble(cox(i))
+         hx8=dble(hx(i))
+         ohx8=dble(ohx(i))
+         ho2x8=dble(ho2x(i))
+         h2x8=dble(h2x(i))
+         h2ox8=dble(h2ox(i))
+         h2o2x8=dble(h2o2x(i))
+         o1dx8=dble(o1dx(i))
+         tx8=dble(tx(i))
+
+
+c     reaction rates         
+
+         call getch(tx8)
+
+c         print*,i,co2x(i),o2x(i),o3px(i),cox(i),hx(i),ohx(i),ho2x(i),
+c     &            h2x(i),h2ox(i),h2o2x(i),o1dx(i),tx(i),zdens(i)
+
+
+c     photodissotiation rates
+
+         jdistot(1,i) = 0.
+         jdistot(2,i) = 0.
+         jdistot(3,i) = 0.
+         jdistot(4,i) = 0.
+         jdistot(5,i) = 0.
+         jdistot(6,i) = 0.
+         jdistot_b(1,i) = 0.
+         jdistot_b(2,i) = 0.
+
+         call phdisrate(zenit,i)
+
+         do j=1,6
+            jdistot8(j,i) = dble(jdistot(j,i))
+         end do
+         jdistot8_b(1,i) = dble(jdistot_b(1,i))
+         jdistot8_b(2,i) = dble(jdistot_b(2,i))
+         
+         
+c     Lifetimes calculation
+
+         do j=1,nreact
+            tauco2(i,j) = 1.d30
+            tauo2(i,j) = 1.d30
+            tauo3p(i,j) = 1.d30
+            tauco(i,j) = 1.d30
+            tauh(i,j) = 1.d30
+            tauoh(i,j) = 1.d30
+            tauho2(i,j) = 1.d30
+            tauh2(i,j) = 1.d30
+            tauh2o(i,j) = 1.d30
+            tauo1d(i,j) = 1.d30
+            tauh2o2(i,j) = 1.d30
+         end do
+
+         if(jdistot8(1,i).gt.1d-30) tauco2(i,1) = 1.d0 / jdistot8(1,i)
+
+         if(ch2*o2x8*co2x8.gt.1d-30) 
+     $      tauh(i,2) = 1.d0 / (ch2 * o2x8 * co2x8)  
+         if(ch2*hx8*co2x8.gt.1d-30)
+     $      tauo2(i,2) = 1.d0 / (ch2 * hx8 * co2x8)
+ 
+         if(ch3*o3px8.gt.1d-30) tauho2(i,3) = 1.d0 / (ch3 * o3px8)
+         if(ch3*ho2x8.gt.1d-30) tauo3p(i,3) = 1.d0 / (ch3 * ho2x8)
+ 
+         if(ch4*cox8.gt.1d-30) tauoh(i,4) = 1.d0 / (ch4 * cox8)
+         if(ch4*ohx8.gt.1d-30) tauco(i,4) = 1.d0 / (ch4 * ohx8)
+ 
+         if(ch5*ho2x8.gt.1d-30)tauho2(i,5) = 1.d0 / (2.d0 * ch5 * ho2x8)
+
+         if(jdistot8(6,i).gt.1d-30) tauh2o2(i,6) = 1.d0 / jdistot8(6,i)
+
+         if(ch7*ohx8.gt.1d-30) tauho2(i,7) = 1.d0 / (ch7 * ohx8)
+         if(ch7*ho2x8.gt.1d-30) tauoh(i,7) = 1.d0 / (ch7 * ho2x8)
+ 
+         if(jdistot8(4,i).gt.1d-30) tauh2o(i,8) = 1.d0 / jdistot8(4,i)
+
+         if(ch9*o1dx8.gt.1d-30) tauh2o(i,9) = 1.d0 / (ch9 * o1dx8)
+         if(ch9*h2ox8.gt.1d-30) tauo1d(i,9) = 1.d0 / (ch9 * h2ox8)
+
+         if(ch10*o3px8*co2x8.gt.1d-30) 
+     $     tauo3p(i,10) = 1.d0 / (2.d0 * ch10 * o3px8 * co2x8)
+
+         if(ch11*o3px8.gt.1d-30) tauoh(i,11) = 1.d0 / (ch11 * o3px8)
+         if(ch11*ohx8.gt.1d-30) tauo3p(i,11) = 1.d0 / (ch11 * ohx8)
+
+         if(jdistot8(2,i).gt.1d-30) tauo2(i,12) = 1.d0 / jdistot8(2,i)
+
+         if(ch13*hx8.gt.1d-30) tauho2(i,13) = 1.d0 / (ch13 * hx8)
+         if(ch13*ho2x8.gt.1d-30) tauh(i,13) = 1.d0 / (ch13 * ho2x8)
+
+         if(ch14*o1dx8.gt.1d-30) tauh2(i,14) = 1.d0 / (ch14 * o1dx8)
+         if(ch14*h2x8.gt.1d-30) tauo1d(i,14) = 1.d0 / (ch14 * h2x8)
+
+         if(ch15*ohx8.gt.1d-30) tauh2(i,15) = 1.d0 / (ch15 * ohx8)
+         if(ch15*h2x8.gt.1d-30) tauoh(i,15) = 1.d0 / (ch15 * h2x8)
+
+         if(jdistot8_b(1,i).gt.1d-30) tauco2(i,16) =1.d0/jdistot8_b(1,i)
+
+         if(jdistot8_b(2,i).gt.1d-30) tauo2(i,17) =1.d0/jdistot8_b(2,i)
+
+         if(ch18*ohx8.gt.1d-30) tauh2o2(i,18) = 1.d0 / (ch18 * ohx8)
+         if(ch18*h2o2x8.gt.1d-30) tauoh(i,18) = 1.d0 / (ch18 * h2o2x8)
+
+         if(ch19*co2x8.gt.1d-30) tauo1d(i,19) = 1.d0 / (ch19 * co2x8)
+
+         if(ch20*o2x8.gt.1d-30) tauo1d(i,20) = 1.d0 / (ch20 * o2x8)
+
+         if(ch21*o2x8*co2x8.gt.1d-30) tauo3p(i,21) = 1.d0 / 
+     $        (ch21 * o2x8 * co2x8)
+         if(ch21*o3px8*co2x8.gt.1d-30) tauo2(i,21) = 1.d0 / 
+     $        (ch21 * o3px8 * co2x8)
+
+         if(jdistot8(5,i).gt.1d-30) tauh2(i,22) = 1.d0 / jdistot8(5,i)
+
+         !minimum lifetime
+         tminco2(i) = 1.d30
+         tmino2(i) = 1.d30
+         tmino3p(i) = 1.d30
+         tminco(i) = 1.d30
+         tminh(i) = 1.d30
+         tminoh(i) = 1.d30
+         tminho2(i) = 1.d30
+         tminh2(i) = 1.d30
+         tminh2o(i) = 1.d30
+         tmino1d(i) = 1.d30
+         tminh2o2(i) = 1.d30
+         
+         do j=1,nreact
+            tminco2(i) = min(tminco2(i),tauco2(i,j))
+            tmino2(i) = min(tmino2(i),tauo2(i,j))
+            tmino3p(i) = min(tmino3p(i),tauo3p(i,j))
+            tminco(i) = min(tminco(i),tauco(i,j))
+            tminh(i) = min(tminh(i),tauh(i,j))
+            tminoh(i) = min(tminoh(i),tauoh(i,j))
+            tminho2(i) = min(tminho2(i),tauho2(i,j))
+            tminh2(i) = min(tminh2(i),tauh2(i,j))
+            tminh2o(i) = min(tminh2o(i),tauh2o(i,j))
+            tmino1d(i) = min(tmino1d(i),tauo1d(i,j))
+            tminh2o2(i) = min(tminh2o2(i),tauh2o2(i,j))
+         end do
+
+         tmin(i) = 1.d30
+         tmin(i) = min(tmin(i),tminco2(i))
+         tmin(i) = min(tmin(i),tmino2(i))
+         tmin(i) = min(tmin(i),tmino3p(i))
+         tmin(i) = min(tmin(i),tminco(i))
+         tmin(i) = min(tmin(i),tminh(i))
+         tmin(i) = min(tmin(i),tminh2(i))
+         tmin(i) = min(tmin(i),tminh2o(i))
+         tmin(i) = min(tmin(i),tminh2o2(i))
+
+
+         !Internal timestep
+         if(tmin(i)/10.d0.gt.timestep8*3600.d0) then
+            deltat = timestep8 * 3600.d0
+         else
+            deltat = tmin(i)/10.d0
+         end if
+         if(deltat.ne.timestep8*3600.d0) then
+            n=int(timestep8*3600.d0/deltat)+1
+            deltat=timestep8*3600.d0/n
+         endif
+
+
+         !Photochemical equilibrium for O1D,OH and HO2?
+         if(tmino1d(i).lt.deltat/5.d0) then
+            o1d_eq(i)='Y'
+         else 
+            o1d_eq(i)='N'
+c            o1d_eq(i)='Y'
+         endif
+         if(tminoh(i).lt.deltat/5.d0) then
+           oh_eq(i)='Y'
+         else
+           oh_eq(i)='N'
+c           oh_eq(i)='Y'
+         end if
+         if(tminho2(i).lt.deltat/5.d0) then
+            ho2_eq(i)='Y'
+         else
+            ho2_eq(i)='N'
+c            ho2_eq(i)='Y'
+         endif
+
+
+C     Start: temporal loop
+c        do dt=deltat,timestep8*3600.d0,deltat
+         do nt=1,int(timestep8*3600.d0/deltat)
+            dt=nt*deltat
+
+            !Productions and losses
+            do j=1,nreact
+               Lco2(i,j) = 0.d0
+               Pco2(i,j) = 0.d0
+               Lo2(i,j) = 0.d0
+               Po2(i,j) = 0.d0
+               Lo3p(i,j) = 0.d0
+               Po3p(i,j) = 0.d0
+               Lco(i,j) = 0.d0
+               Pco(i,j) = 0.d0
+               Ph(i,j) = 0.d0
+               Lh(i,j) = 0.d0
+               Poh(i,j) = 0.d0
+               Loh(i,j) = 0.d0
+               Pho2(i,j) = 0.d0
+               Lho2(i,j) = 0.d0
+               Ph2(i,j) = 0.d0
+               Lh2(i,j) = 0.d0
+               Ph2o(i,j) = 0.d0
+               Lh2o(i,j) = 0.d0
+               Po1d(i,j) = 0.d0
+               Lo1d(i,j) = 0.d0
+               Ph2o2(i,j) = 0.d0
+               Lh2o2(i,j) = 0.d0
+            end do
+            Pco2tot(i) = 0.d0
+            Lco2tot(i) = 0.d0
+            Po2tot(i) = 0.d0
+            Lo2tot(i) = 0.d0
+            Po3ptot(i) = 0.d0
+            Lo3ptot(i) = 0.d0
+            Pcotot(i) = 0.d0
+            Lcotot(i) = 0.d0
+            Phtot(i) = 0.d0
+            Lhtot(i) = 0.d0
+            Pohtot(i) = 0.d0
+            Lohtot(i) = 0.d0
+            Pho2tot(i) = 0.d0
+            Lho2tot(i) = 0.d0
+            Ph2tot(i) = 0.d0
+            Lh2tot(i) = 0.d0
+            Ph2otot(i) = 0.d0
+            Lh2otot(i) = 0.d0
+            Po1dtot(i) = 0.d0
+            Lo1dtot(i) = 0.d0
+            Ph2o2tot(i) = 0.d0
+            Lh2o2tot(i) = 0.d0
+
+
+c           R1: CO2 + hv -> CO + O
+
+            Lco2(i,1) = jdistot8(1,i)
+            Pco(i,1) = co2x8 * jdistot8(1,i)
+            Po3p(i,1) = co2x8 * jdistot8(1,i)
+
+
+c           R16(1b): CO2 + hv -> CO + O1D
+
+            Lco2(i,16) = jdistot8_b(1,i)
+            Pco(i,16) = co2x8 * jdistot8_b(1,i)
+            Po1d(i,16) = co2x8 * jdistot8_b(1,i)
+
+
+c           R2: H + O2 + CO2 -> HO2 + CO2
+
+            Lh(i,2) = ch2 * o2x8 * co2x8
+            Lo2(i,2) = ch2 * hx8 * co2x8
+            Pho2(i,2) = ch2 * hx8 * o2x8 * co2x8
+
+
+c           R3: O + HO2 -> OH + O2
+
+            Lo3p(i,3) = ch3 * ho2x8 
+            Lho2(i,3) = ch3 * o3px8
+            Poh(i,3) = ch3 * o3px8 * ho2x8
+            Po2(i,3) = ch3 * o3px8 * ho2x8
+
+
+c           R4: CO + OH -> CO2 + H
+
+            Lco(i,4) = ch4 * ohx8
+            Loh(i,4) = ch4 * cox8
+            Pco2(i,4) = ch4 * cox8 * ohx8
+            Ph(i,4) = ch4 * cox8 * ohx8
+
+
+c           R5: 2HO2 -> H2O2 + O2
+
+            Lho2(i,5) = 2.d0 * ch5 * ho2x8 
+            Po2(i,5) = ch5 * ho2x8 * ho2x8 
+            Ph2o2(i,5) = ch5 * ho2x8 * ho2x8
+
+
+c           R6: H2O2 + hv -> 2OH
+
+            Lh2o2(i,6) = jdistot8(6,i) 
+            Poh(i,6) = jdistot8(6,i) * h2o2x8
+
+
+c           R7: OH + HO2 -> H2O + O2
+
+            Loh(i,7) = ch7 * ho2x8 
+            Lho2(i,7) = ch7 * ohx8
+            Po2(i,7) = ch7 * ohx8 * ho2x8
+            Ph2o(i,7) = ch7 * ohx8 * ho2x8
+
+
+c           R8: H20 + hv -> H + OH
+
+            Lh2o(i,8) = jdistot8(4,i)
+            Ph(i,8) = jdistot8(4,i) * h2ox8
+            Poh(i,8) = jdistot8(4,i) * h2ox8
+
+
+c           R9: O(1D) + H2O -> 2OH
+
+            Lo1d(i,9) = ch9 * h2ox8
+            Lh2o(i,9) = ch9 * o1dx8
+            Poh(i,9) = 2.d0 * ch9 * o1dx8 * h2ox8 
+         
+
+c           R10: 2O + CO2 -> O2 + CO2
+
+            Lo3p(i,10) = 2.d0 * ch10 * o3px8 * co2x8  
+            Po2(i,10) = ch10 * o3px8 * o3px8 * co2x8
+
+
+c           R11: O + OH -> O2 + H
+
+            Lo3p(i,11) = ch11 * ohx8
+            Loh(i,11) = ch11 * o3px8
+            Po2(i,11) = ch11 * o3px8 * ohx8
+            Ph(i,11) = ch11 * o3px8 * ohx8
+
+
+c           R12: O2 + hv -> 2O
+
+            Lo2(i,12) = jdistot8(2,i)
+            Po3p(i,12) = 2.d0 * jdistot8(2,i) * o2x8
+
+
+c           R17(12b): O2 + hv -> O + O1D
+
+            Lo2(i,17) = jdistot8_b(2,i)
+            Po3p(i,17) = jdistot8_b(2,i) * o2x8
+            Po1d(i,17) = jdistot8_b(2,i) * o2x8
+
+
+c           R13: H + HO2 -> H2 + O2
+
+            Lh(i,13) = ch13 * ho2x8 
+            Lho2(i,13) = ch13 * hx8
+            Ph2(i,13) = ch13 * hx8 * ho2x8
+            Po2(i,13) = ch13 * hx8 * ho2x8
+
+
+c           R14: O(1D) + H2 -> H + OH
+
+            Lo1d(i,14) = ch14 * h2x8
+            Lh2(i,14) = ch14 * o1dx8
+            Ph(i,14) = ch14 * o1dx8 * h2x8
+            Poh(i,14) = ch14 * o1dx8 * h2x8
+
+
+c           R15: OH + H2 -> H + H20
+
+            Loh(i,15) = ch15 * h2x8
+            Lh2(i,15) = ch15 * ohx8
+            Ph(i,15) = ch15 * ohx8 * h2x8
+            Ph2o(i,15) = ch15 * ohx8 * h2x8
+
+
+c           R18: OH + H2O2 -> H2O + HO2
+
+            Loh(i,18) = ch18 * h2o2x8
+            Lh2o2(i,18) = ch18 * ohx8
+            Ph2o(i,18) = ch18 * ohx8 * h2o2x8
+            Pho2(i,18) = ch18 * ohx8 * h2o2x8
+
+
+c           R19: O(1D) + CO2 -> O + CO2
+
+            Lo1d(i,19) = ch19 * co2x8
+            Po3p(i,19) = ch19 * o1dx8 * co2x8
+
+
+c           R20: O(1D) + O2 -> O + O2
+
+            Lo1d(i,20) = ch20 * o2x8
+            Po3p(i,20) = ch20 * o1dx8 * o2x8
+
+
+c           R21: O + O2 + CO2 -> O3 + CO2
+
+            Lo3p(i,21) = ch21 * o2x8 * co2x8
+            Lo2(i,21) = ch21 * o3px8 * co2x8
+
+
+c           R22: H2 + hv -> 2H
+
+            Lh2(i,22) = jdistot8(5,i)
+            Ph(i,22) = 2.d0 * jdistot8(5,i) * h2x8 
+
+
+            do j=1,nreact
+               Pco2tot(i) = Pco2tot(i) + Pco2(i,j)
+               Lco2tot(i) = Lco2tot(i) + Lco2(i,j)
+               Po2tot(i) = Po2tot(i) + Po2(i,j)
+               Lo2tot(i) = Lo2tot(i) + Lo2(i,j)
+               Po3ptot(i) = Po3ptot(i) + Po3p(i,j)
+               Lo3ptot(i) = Lo3ptot(i) + Lo3p(i,j)
+               Pcotot(i) = Pcotot(i) + Pco(i,j)
+               Lcotot(i) = Lcotot(i) + Lco(i,j)
+               Phtot(i) = Phtot(i) + Ph(i,j)
+               Lhtot(i) = Lhtot(i) + Lh(i,j)
+               Pohtot(i) = Pohtot(i) + Poh(i,j)
+               Lohtot(i) = Lohtot(i) + Loh(i,j)
+               Pho2tot(i) = Pho2tot(i) + Pho2(i,j)
+               Lho2tot(i) = Lho2tot(i) + Lho2(i,j)
+               Ph2tot(i) = Ph2tot(i) + Ph2(i,j)
+               Lh2tot(i) = Lh2tot(i) + Lh2(i,j)
+               Ph2otot(i) = Ph2otot(i) + Ph2o(i,j)
+               Lh2otot(i) = Lh2otot(i) + Lh2o(i,j)
+               Po1dtot(i) = Po1dtot(i) + Po1d(i,j)
+               Lo1dtot(i) = Lo1dtot(i) + Lo1d(i,j)
+               Ph2o2tot(i) = Ph2o2tot(i) + Ph2o2(i,j)
+               Lh2o2tot(i) = Lh2o2tot(i) + Lh2o2(i,j)
+            end do
+
+
+            !New concentrations, implicit scheme
+            co2x8 = (co2x8 + Pco2tot(i) * deltat) /
+     $                (1.d0 + Lco2tot(i) * deltat)
+            o2x8 = (o2x8 + Po2tot(i) * deltat) /
+     $               (1.d0 + Lo2tot(i) * deltat)
+            o3px8 = (o3px8 + Po3ptot(i) * deltat) /
+     $                (1.d0 + Lo3ptot(i) * deltat)
+            cox8 = (cox8 + Pcotot(i) * deltat) /
+     $               (1.d0 + Lcotot(i) * deltat)
+            hx8 = (hx8 + Phtot(i) * deltat) /
+     $              (1.d0 + Lhtot(i) * deltat)
+             h2x8 = (h2x8 + Ph2tot(i) * deltat) /
+     $               (1.d0 + Lh2tot(i) * deltat)
+            h2ox8 = (h2ox8 + Ph2otot(i) * deltat) / 
+     $                (1.d0 + Lh2otot(i) * deltat)
+            h2o2x8 = (h2o2x8 + Ph2o2tot(i) * deltat) /
+     $                (1.d0 + Lh2o2tot(i) * deltat)
+
+            if(o1d_eq(i).eq.'Y') then
+               auxp=jdistot8_b(1,i)*co2x8+jdistot8_b(2,i)*o2x8
+               auxl=ch9*h2ox8+ch14*h2x8+ch19*co2x8+ch20*o2x8
+               if(auxl.ne.0.) then
+                  o1dx8=auxp/auxl
+               else
+                  o1dx8=o1dx8+Po1dtot(i)*deltat
+               endif
+            else
+               o1dx8 = (o1dx8 + Po1dtot(i) * deltat) /
+     $                   (1.d0 + Lo1dtot(i) * deltat)
+            end if
+
+            if(oh_eq(i).eq.'Y') then
+               auxp=ch3*o3px8*ho2x8+jdistot(4,i)*h2ox8+
+     $              2.d0*ch9*o1dx8*h2ox8+ch14*o1dx8*h2x8+
+     $              2.d0*jdistot(6,i)*h2o2x8
+               auxl=ch4*cox8+ch7*ho2x8+ch11*o3px8+ch15*h2x8+
+     $              ch18*h2o2x8
+               if(auxl.ne.0.) then
+                  ohx8=auxp/auxl
+               else
+                  ohx8=ohx8+Pohtot(i)*deltat
+               end if
+            else
+               ohx8 = (ohx8 + Pohtot(i) * deltat) /
+     $                  (1.d0 + Lohtot(i) * deltat)
+            end if
+
+            if(ho2_eq(i).eq.'Y') then
+               auxp=ch2*hx8*o2x8*co2x8+ch18*ohx8*h2o2x8
+               auxl=ch3*o3px8+2.d0*ch5*ho2x8+ch7*ohx8+ch13*hx8
+               if(auxl.ne.0.) then
+                  ho2x8=auxp/auxl
+               else
+                  ho2x8=ho2x8+Pho2tot(i)*deltat
+               end if
+            else
+               ho2x8 = (ho2x8 + Pho2tot(i) * deltat) /
+     $                  (1.d0 + Lho2tot(i) * deltat)
+            end if
+
+
+C        End: temporal loop
+         end do
+         
+         
+         co2x(i)  = real(co2x8)
+         o2x(i)   = real(o2x8)
+         o3px(i)  = real(o3px8)
+         cox(i)   = real(cox8)
+         hx(i)    = real(hx8)
+         ohx(i)   = real(ohx8)
+         ho2x(i)  = real(ho2x8)
+         h2x(i)   = real(h2x8)
+         h2ox(i)  = real(h2ox8)
+         h2o2x(i) = real(h2o2x8)
+         o1dx(i)  = real(o1dx8)
+
+c         co2x(i)=(co2x8)
+c         o2x(i)=(o2x8)
+c         o3px(i)=(o3px8)
+c         cox(i)=(cox8)
+c         hx(i)=(hx8)
+c         ohx(i)=(ohx8)
+c         ho2x(i)=(ho2x8)
+c         h2x(i)=(h2x8)
+c         h2ox(i)=(h2ox8)
+c         h2o2x(i)=(h2o2x8)
+c         o1dx(i)=(o1dx8)
+
+C     End: altitude loop
+      end do
+
+      return
+
+      end
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/perosat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/perosat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/perosat.F	(revision 46)
@@ -0,0 +1,141 @@
+      SUBROUTINE perosat(ig, ptimestep,
+     $                   pplev, pplay, zt,
+     &                   zy, pdqcloud, pdqscloud)
+      IMPLICIT NONE
+
+c=======================================================================
+c     Treatment of saturation of hydrogen peroxide (H2O2)
+c
+c     Modif de zq si saturation dans l'atmopshere
+c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+c     Le test est effectue de bas en haut. H2O2 condense
+c    (si saturation) est remis dans la couche en dessous.
+c     H2O2 condense dans la couche du bas est depose a la surface
+c
+c     WARNING : H2O2 mixing ratio is assumed to be q(igcm_h2o2)   
+c               index igcm_h2o2 is known from tracer.h 
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ig
+      REAL ptimestep                ! pas de temps physique (s)
+      REAL pplev(ngridmx,nlayermx+1)! pression aux inter-couches (Pa)
+      REAL pplay(ngridmx,nlayermx)  ! pression au milieu des couches (Pa)
+      REAL zt(nlayermx)             ! temperature au centre des couches (K)
+                                    ! deja mise a jour dans calchim
+
+c   Traceurs :
+      real zy(nlayermx,nqmx)        ! traceur (fraction molaire sortie chimie)
+      real pdqcloud(ngridmx,nlayermx,nqmx) ! tendance condensation (kg/kg.s-1)
+      real pdqscloud(ngridmx,nqmx)         ! flux en surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,iq
+
+      REAL zysat(nlayermx)
+      REAL zynew(nlayermx)             ! mole fraction after condensation
+      REAL psat_hg                     ! pression saturante (mm Hg)
+      REAL psat_hpa                    ! pression saturante (hPa)
+      logical,save :: firstcall=.true.
+
+c     Pour diagnostique :
+c     ~~~~~~~~~~~~~~~~~
+      REAL taucond(ngridmx,nlayermx)   ! taux de condensation (kg/kg/s-1)
+
+c-----------------------------------------------------------------------
+c    1. initialisation/verification
+c    ------------------------------
+c
+       if (firstcall) then
+         ! check that there is an h2o2 tracer:
+         if (igcm_h2o2.eq.0) then
+           write(*,*) "perosat: error; no h2o2 tracer !!!!"
+           stop
+         endif
+         firstcall=.false.
+       endif
+
+c    ----------------------------------------------
+c    
+c       Rapport de melange a saturation dans la couche l :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c       d'apres Lindner, Planet. Space Sci., 36, 125, 1988.
+c       domaine d'application: T < 220 K
+c
+        do l = 1,nlayermx
+
+c       print *,'ig=',ig,' l=',l,' igcm_h2o2=',igcm_h2o2
+c       print *,'y=',zy(l,igcm_h2o2),' T=',zt(l)
+
+             zynew(l) = zy(l,igcm_h2o2)
+
+             if (zt(l) .le. 220.) then
+               psat_hg = 10.**(11.98 - (3422./zt(l)))
+               psat_hpa = psat_hg*760./1013.
+               zysat(l) = (psat_hpa*100./pplay(ig,l))
+             else
+               zysat(l) = 1.e+30
+             end if
+
+c       print *,'ysat=',zysat(l)
+
+        end do
+
+c       taux de condensation (kg/kg/s-1) dans les differentes couches
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       (Pour diagnostic seulement !)
+c
+        do l=1, nlayermx
+          taucond(ig,l)=max((zy(l,igcm_h2o2)-zysat(l))*mmol(igcm_h2o2)
+     $                         /(mmean(ig,l)*ptimestep),0.)
+        end do
+c
+c       Saturation couche nlay a 2 :  
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+        do l=nlayermx,2, -1
+           if (zynew(l).gt.zysat(l)) then
+              zynew(l-1) =  zynew(l-1) + (zynew(l) - zysat(l))
+     &      *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+
+              zynew(l)=zysat(l)
+           endif
+        enddo
+c
+c       Saturation couche l=1 
+c       ~~~~~~~~~~~~~~~~~~~~~
+c
+        if (zynew(1).gt.zysat(1)) then
+           pdqscloud(ig,igcm_h2o2)= (zynew(1)-zysat(1))*mmol(igcm_h2o2)
+     $   *(pplev(ig,1)-pplev(ig,2))/(mmean(ig,1)*g*ptimestep)
+c
+           zynew(1)=zysat(1)
+        end if
+c
+c       Tendance finale
+c       ~~~~~~~~~~~~~~~
+c
+        do l=1, nlayermx
+          pdqcloud(ig,l,igcm_h2o2)=(zynew(l) - zy(l,igcm_h2o2))
+     &                     *mmol(igcm_h2o2)/(mmean(ig,l)*ptimestep) 
+c          print *,'pdqcloud=',pdqcloud(ig,l,igcm_h2o2)
+        end do
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/phdisrate.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/phdisrate.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/phdisrate.F	(revision 46)
@@ -0,0 +1,109 @@
+c**********************************************************************
+
+      subroutine phdisrate(zenit,i)
+
+c     apr 2002       fgg           first version
+c**********************************************************************
+
+
+      implicit none
+
+      include 'param.h'
+      include 'param_v3.h'
+
+c     arguments
+
+      integer         i                !altitude
+      real            zenit
+
+c     local variables
+
+      integer         inter,iz
+      real            lambda
+      real            jdis(nabs,ninter,nzmax)
+      character*1     dn
+
+
+c**********************************************************************
+
+      if(zenit.gt.100.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+
+      if(dn.eq.'n') then
+         jdistot(1,i) = 0.
+         jdistot(2,i) = 0.
+         jdistot(3,i) = 0.
+         jdistot(4,i) = 0.
+         jdistot(5,i) = 0.
+         jdistot(6,i) = 0.
+         jdistot_b(1,i) = 0.
+         jdistot_b(2,i) = 0.
+      else
+
+c     photodissociation rate
+
+         jdistot(1,i)=0.
+         jdistot(2,i)=0.
+         jdistot(4,i)=0.
+         jdistot(6,i)=0.
+         jdistot_b(1,i)=0.
+         jdistot_b(2,i)=0.
+         do inter=1,32
+            jdis(1,inter,i) = jfotsout(inter,1,i) * fluxtop(inter) 
+     $      * efdisco2(inter)
+            if(inter.gt.29.and.inter.le.32) then
+               jdistot(1,i) = jdistot(1,i) + jdis(1,inter,i)
+            else if(inter.le.29) then
+               jdistot_b(1,i) = jdistot_b(1,i) + jdis(1,inter,i)
+            end if
+         end do
+
+         do inter=1,31
+            jdis(2,inter,i) = jfotsout(inter,2,i) * fluxtop(inter)
+     $      * efdiso2(inter)
+            if(inter.ge.31) then
+               jdistot(2,i) = jdistot(2,i) + jdis(2,inter,i)
+            else if(inter.lt.31) then
+               jdistot_b(2,i) = jdistot_b(2,i) + jdis(2,inter,i)
+            end if
+         end do
+
+         jdistot(3,i) = 0.
+
+         do inter=25,31
+            jdis(4,inter,i) = jfotsout(inter,4,i) * fluxtop(inter)
+     $      * efdish2o(inter)
+            jdistot(4,i) = jdistot(4,i) + jdis(4,inter,i)
+         end do
+
+         do inter=1,15
+            jdis(5,inter,i) = jfotsout(inter,5,i) * fluxtop(inter)
+     $      * efdish2(inter)
+            jdistot(5,i) = jdistot(5,i) + jdis(5,inter,i)
+         end do
+
+         do inter=25,33
+            jdis(6,inter,i) = jfotsout(inter,6,i) * fluxtop(inter)
+     $      * efdish2o2(inter) 
+            jdistot(6,i) = jdistot(6,i) + jdis(6,inter,i)
+         end do 
+      end if
+
+
+      return
+      
+
+      end
+
+
+
+
+
+
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/photochemist_B.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/photochemist_B.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/photochemist_B.F	(revision 46)
@@ -0,0 +1,1710 @@
+c*****************************************************************
+c
+c     Photochemical routines for Scheme B
+c
+c     Author: Franck Lefevre
+c     ------
+c
+c     update 12/06/2003: compatibility with dust and iceparty
+c        (S. Lebonnois)
+c     update sept. 2008: identify tracer indexes using tracer names
+c        (Ehouarn Millour)
+c
+c*****************************************************************
+c
+      subroutine photochemist_B(lswitch,zycol, sza, ptimestep, press,
+c     $                          temp, dens, dist_sol)
+     $                          temp, dens, dist_sol, jo3)
+c
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+#include "callkeys.h"
+#include "tracer.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     input/output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)  ! chemical species volume mixing ratio
+c if water, zycol(l,i_h2o_ice) is ice surface area (in microns^2/cm^3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real sza                   ! solar zenith angle (deg)
+      real ptimestep             ! physics timestep (s)
+      real press(nlayermx)       ! pressure (hpa)
+      real temp(nlayermx)        ! temperature (k)
+      real dens(nlayermx)        ! density (cm-3)
+      real dist_sol              ! sun distance (au) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real jo3(nlayermx)  ! photodissociation rate O3 -> O1D
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer phychemrat         ! ratio physics timestep/chemistry timestep
+      integer istep
+      integer i_o3,lev,iq
+      integer nesp
+      integer lswitch
+c
+      parameter (nesp = 15)      ! number of species in the chemistry
+c
+      real ctimestep             ! chemistry timestep (s) 
+      real rm(nlayermx,nesp)     ! species volume mixing ratio 
+      real j(nlayermx,nd)        ! interpolated photolysis rates (s-1)
+      real icesurf(nlayermx)     ! ice surface area (cm^2/cm^3)
+      real rmo3(nlayermx)        ! ozone mixing ratio
+c
+c     reaction rates
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+
+      logical,save :: firstcall=.true.
+      integer,save :: i_h2o_ice=0 ! water ice tracer index
+
+! Initializations (at first call only)
+      if (firstcall) then
+        ! find index of water ice tracer
+        do iq=1,nqmx
+          if (noms(iq).eq."h2o_ice") then
+            i_h2o_ice=iq
+          endif
+        enddo
+        ! verify that it is the same index as the global one:
+        if (i_h2o_ice.ne.igcm_h2o_ice) then
+          write(*,*) "photochemist_B: Error ; found water ice tracer",
+     &               " index ",i_h2o_ice," does not match GCM index ",
+     &               " igcm_h2o_ice=",igcm_h2o_ice
+          stop
+        endif
+        ! also check that there indeed is an "h2o_ice" tracer
+        if (i_h2o_ice.eq.0) then
+          write(*,*) "photochemist_B: Error ; did not find",
+     &               " water ice tracer"
+          stop
+        endif
+        firstcall=.false.
+      endif
+
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     ctimestep : chemistry timestep (s)                         c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      ctimestep = 10.*60.
+c
+      phychemrat = int(ptimestep/ctimestep)
+c     print*,"PHYCHEMRAT = ",phychemrat
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialisation of chemical species and families            c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call gcmtochim(zycol, lswitch, nesp, rm) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     ice surface area for heterogenous chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (water) then
+       do lev=1,lswitch-1
+!        icesurf(lev)= zycol(lev,nqmx-1)*1.e-8 ! microns^2 -> cm^2
+        icesurf(lev)= zycol(lev,i_h2o_ice)*1.e-8 ! microns^2 -> cm^2
+       enddo
+      else
+       do lev=1,lswitch-1
+        icesurf(lev)=0.0e0
+       enddo
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     compute reaction rates                                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call chemrates(lswitch, dens, press, temp, icesurf,
+     $               a001, a002, a003,
+     $               b001, b002, b003, b004, b005, b006,
+     $               c001, c002, c003, c004, c005, c006,
+     $               c007, c008, c009, c010, c011, c012,
+     $               c013, c014, c015, c016, c017, c018,
+     $               d001, d002, d003,
+     $               e001, e002,
+     $               h001, h002)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     interpolation of photolysis rates in the lookup table      c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_o3 = 5 
+c
+      do lev=1,lswitch-1
+        rmo3(lev)=rm(lev,i_o3)
+      enddo
+
+      call phot(lswitch, press, temp, sza, dist_sol, rmo3, j)
+c
+      do lev=1,lswitch-1
+        jo3(lev) = j(lev,5)
+      enddo
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over time within the physical timestep                c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do istep = 1,phychemrat
+         call chimie_B(lswitch,nesp, rm, j, dens, ctimestep, 
+     $                 press, temp, sza, dist_sol,
+     $                 a001, a002, a003,
+     $                 b001, b002, b003, b004, b005, b006,
+     $                 c001, c002, c003, c004, c005, c006,
+     $                 c007, c008, c009, c010, c011, c012,
+     $                 c013, c014, c015, c016, c017, c018,
+     $                 d001, d002, d003,
+     $                 e001, e002,
+     $                 h001, h002)
+c
+c        print*,'appel chimie ok iteration ', istep
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     save chemical species for the gcm                          c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      call chimtogcm(zycol, lswitch, nesp, rm) 
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chimie_B(lswitch, nesp, rm, j, dens, dt, 
+     $                    press, t, sza, dist_sol,
+     $                    a001, a002, a003,
+     $                    b001, b002, b003, b004, b005, b006,
+     $                    c001, c002, c003, c004, c005, c006,
+     $                    c007, c008, c009, c010, c011, c012,
+     $                    c013, c014, c015, c016, c017, c018,
+     $                    d001, d002, d003,
+     $                    e001, e002,
+     $                    h001, h002)
+c
+c*****************************************************************
+c
+      implicit none 
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+#include "callkeys.h" 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     input/output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      integer lswitch         ! interface level between chemistries
+      integer nesp            ! number of species
+c
+      real rm(nlayermx,nesp)  ! volume mixing ratios 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real dens(nlayermx)     ! density (cm-3)
+      real dt                 ! chemistry timestep (s) 
+      real j(nlayermx,nd)     ! interpolated photolysis rates (s-1) 
+      real press(nlayermx)    ! pressure (hpa)
+      real t(nlayermx)        ! temperature (k)
+      real sza                ! solar zenith angle (deg)
+      real dist_sol           ! sun distance (au) 
+c
+c     reaction rates
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer HETERO
+      parameter (HETERO=0)
+
+      integer iesp, iter, l, niter
+      integer i_co2, i_co, i_o2, i_h2, i_h2o, i_h2o2, i_hox, i_ox,
+     $        i_o1d, i_o, i_o3, i_h, i_oh, i_ho2, i_n2
+      integer j_o2_o, j_o2_o1d, j_co2_o, j_co2_o1d,
+     $        j_o3_o1d, j_o3_o, j_h2o, j_hdo, j_h2o2,
+     $        j_ho2, j_no2
+c
+      parameter (niter = 5)          ! iterations in the chemical scheme
+c
+      real*8 cc0(nlayermx,nesp)        ! initial number density (cm-3)
+      real*8 cc(nlayermx,nesp)         ! final number density (cm-3)
+      real*8 co2(nlayermx)             ! co2 number density (cm-3)
+      real*8 nox(nlayermx)             ! nox number density (cm-3)
+      real*8 no(nlayermx)              ! no  number density (cm-3)
+      real*8 no2(nlayermx)             ! no2 number density (cm-3)
+      real*8 production(nlayermx,nesp) ! production rate
+      real*8 loss(nlayermx,nesp)       ! loss rate
+c
+      real c007h(nlayermx)           ! c007 rate modified
+c                                    ! by heterogenous reactions h001 and h002
+c
+      real ro_o3, rh_ho2, roh_ho2, rno2_no
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracer numbering in the chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      i_co2    =  1
+      i_co     =  2
+      i_o      =  3
+      i_o1d    =  4
+      i_o2     =  5
+      i_o3     =  6
+      i_h      =  7
+      i_h2     =  8
+      i_oh     =  9
+      i_ho2    = 10 
+      i_h2o2   = 11
+      i_h2o    = 12
+      i_n2     = 13
+      i_hox    = 14
+      i_ox     = 15
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     numbering of photolysis rates
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      j_o2_o     =  1      ! o2 + hv   -> o + o
+      j_o2_o1d   =  2      ! o2 + hv   -> o + o(1d)
+      j_co2_o    =  3      ! co2 + hv  -> co + o
+      j_co2_o1d  =  4      ! co2 + hv  -> co + o(1d)
+      j_o3_o1d   =  5      ! o3 + hv   -> o2 + o(1d)
+      j_o3_o     =  6      ! o3 + hv   -> o2 + o
+      j_h2o      =  7      ! h2o + hv  -> h + oh
+      j_hdo      =  8      ! hdo + hv  -> d + oh
+      j_h2o2     =  9      ! h2o2 + hv -> oh + oh
+      j_ho2      =  10     ! ho2 + hv  -> oh + o
+      j_no2      =  11     ! no2 + hv  -> no + o
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     volume mixing ratio -> density conversion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iesp = 1,nesp
+         do l = 1,lswitch-1
+            cc0(l,iesp) = rm(l,iesp)*dens(l)
+            cc(l,iesp)  = cc0(l,iesp)
+         end do
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     co2 and nox number densities (cm-3)    
+c      
+c     co2 mixing ratio: 0.953
+c     nox mixing ratio: 6.e-10 (yung and demore, 1999)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         co2(l) = cc(l,i_co2)
+         nox(l) = 6.e-10*dens(l)
+      end do 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over iterations in the chemical scheme
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iter = 1,niter
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     modification of c007
+c        by heterogenous reactions h001 and h002
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (HETERO.eq.1) then
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+     $            + h001(l)/max(cc(l,i_oh), 1.d-30*dens(l))
+     $            + h002(l)/max(cc(l,i_ho2),1.d-30*dens(l))
+c         write(*,*) "C007 = ",c007(l)," / C007H = ",c007h(l)
+       end do
+      else
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+       end do
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        nox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no2/no
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+         rno2_no = (d002(l)*cc(l,i_o3) + d003(l)*cc(l,i_ho2))
+     $            /(j(l,j_no2) +
+     $              d001(l)*max(cc(l,i_o),1.d-30*dens(l)))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         no(l) = nox(l)/(1. + rno2_no)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        no2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         no2(l) = no(l)*rno2_no
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        photochemical equilibrium for oh and ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h/ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+         rh_ho2 = (c001(l)*cc(l,i_o)
+     $           + c004(l)*cc(l,i_h)
+     $           + c005(l)*cc(l,i_h)
+     $           + c006(l)*cc(l,i_h)
+     $           + c007h(l)*cc(l,i_oh)
+     $           + 2.*c008(l)*cc(l,i_ho2)
+     $           + c015(l)*cc(l,i_o3)
+     $           + 2.*c016(l)*cc(l,i_ho2)
+     $           + j(l,j_ho2))
+     $          /(c011(l)*cc(l,i_o2))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oh/ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         roh_ho2 = (c001(l)*cc(l,i_o)
+     $            + c003(l)*cc(l,i_o3)*rh_ho2
+     $            + 2.*c004(l)*cc(l,i_h)
+     $            + 2.*c008(l)*cc(l,i_ho2)
+     $            + c015(l)*cc(l,i_o3)
+     $            + d003(l)*no(l)
+     $            + j(l,j_ho2)
+     $            + j(l,j_h2o)*cc(l,i_h2o)
+     $             /max(cc(l,i_ho2),dens(l)*1.d-30))
+     $            /(c002(l)*cc(l,i_o)
+     $            + c007h(l)*cc(l,i_ho2)
+     $            + e001(l)*cc(l,i_co))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_h) = cc(l,i_hox)
+     $                 /(1. + (1. + roh_ho2)/rh_ho2)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_ho2) = cc(l,i_h)/rh_ho2
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oh
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         cc(l,i_oh) = cc(l,i_ho2)*roh_ho2
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     modification of c007
+c        by heterogenous reactions h001 and h002
+c           after update of cc(l,i_oh) and cc(l,i_ho2)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (HETERO.eq.1) then
+       do l = 1,lswitch-1
+         c007h(l) = c007(l)
+     $            + h001(l)/max(cc(l,i_oh), 1.d-30*dens(l))
+     $            + h002(l)/max(cc(l,i_ho2),1.d-30*dens(l))
+c         write(*,*) "C007 = ",c007(l)," / C007H = ",c007h(l)
+       end do
+      endif
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ox species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        day:
+c        - o1d at photochemical equilibrium 
+c        - o3 at photochemical equilibrium
+c        - continuity equation for ox
+c        night:
+c        - o1d = 0
+c        - continuity equation for o3
+c        - continuity equation for o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        
+      if (sza .le. 95.) then
+c
+         do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o1d) = (j(l,j_co2_o1d)*co2(l)
+     $                   + j(l,j_o2_o1d)*cc(l,i_o2)
+     $                   + j(l,j_o3_o1d)*cc(l,i_o3))
+     $                   /( b001(l)*co2(l)
+     $                   + b002(l)*cc(l,i_h2o)
+     $                   + b003(l)*cc(l,i_h2)
+     $                   + b004(l)*cc(l,i_o2)
+     $                   + b005(l)*cc(l,i_o3)
+     $                   + b006(l)*cc(l,i_o3))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o/o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            ro_o3 = (j(l,j_o3_o1d) + j(l,j_o3_o)
+     $              + a003(l)*cc(l,i_o)
+     $              + c003(l)*cc(l,i_h)
+     $              + c014(l)*cc(l,i_oh)
+     $              + c015(l)*cc(l,i_ho2))
+     $              /(a001(l)*cc(l,i_o2))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o3) = cc(l,i_ox)/(1. + ro_o3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o) = cc(l,i_o3)*ro_o3
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        ox = o + o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_ox) =
+     $                   + j(l,j_co2_o)*co2(l)
+     $                   + j(l,j_co2_o1d)*co2(l)
+     $                   + j(l,j_ho2)*cc(l,i_ho2)
+     $                   + 2.*j(l,j_o2_o)*cc(l,i_o2)
+     $                   + 2.*j(l,j_o2_o1d)*cc(l,i_o2)
+     $                   + c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                   + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                   + d003(l)*cc(l,i_ho2)*no(l)
+c
+            loss(l,i_ox) = 2.*a002(l)*cc(l,i_o)*cc(l,i_o)
+     $                   + 2.*a003(l)*cc(l,i_o)*cc(l,i_o3)
+     $                   + c001(l)*cc(l,i_ho2)*cc(l,i_o)
+     $                   + c002(l)*cc(l,i_oh)*cc(l,i_o)
+     $                   + c003(l)*cc(l,i_h)*cc(l,i_o3)
+     $                   + c012(l)*cc(l,i_o)*cc(l,i_h2o2)
+     $                   + c014(l)*cc(l,i_o3)*cc(l,i_oh)
+     $                   + c015(l)*cc(l,i_o3)*cc(l,i_ho2)
+     $                   + d001(l)*cc(l,i_o)*no2(l)
+     $                   + e002(l)*cc(l,i_o)*cc(l,i_co)
+c
+            loss(l,i_ox) = loss(l,i_ox)/cc(l,i_ox)
+c
+         end do
+c
+      else
+c
+         do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            cc(l,i_o1d) = 0.
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o3
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_o3) = a001(l)*cc(l,i_o2)*cc(l,i_o)
+c
+            loss(l,i_o3) = a003(l)*cc(l,i_o)
+     $                   + c003(l)*cc(l,i_h)
+     $                   + c014(l)*cc(l,i_oh)
+     $                   + c015(l)*cc(l,i_ho2)
+c
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+            production(l,i_o) = c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                        + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+            loss(l,i_o)  =  a001(l)*cc(l,i_o2)
+     $                   + 2.*a002(l)*cc(l,i_o)
+     $                   + a003(l)*cc(l,i_o3)
+     $                   + c001(l)*cc(l,i_ho2)
+     $                   + c002(l)*cc(l,i_oh)
+     $                   + c012(l)*cc(l,i_h2o2)
+     $                   + e002(l)*cc(l,i_co)
+c
+         end do
+      end if
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     other species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        co
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_co) = j(l,j_co2_o)*co2(l)
+     $                      + j(l,j_co2_o1d)*co2(l)
+c
+         loss(l,i_co) = e001(l)*cc(l,i_oh)
+     $                + e002(l)*cc(l,i_o)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        o2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_o2) = 
+     $                  j(l,j_o3_o)*cc(l,i_o3)
+     $                + j(l,j_o3_o1d)*cc(l,i_o3)
+     $                + a002(l)*cc(l,i_o)*cc(l,i_o)
+     $                + 2.*a003(l)*cc(l,i_o)*cc(l,i_o3)
+     $                + 2.*b005(l)*cc(l,i_o1d)*cc(l,i_o3)
+     $                + b006(l)*cc(l,i_o1d)*cc(l,i_o3)
+     $                + c001(l)*cc(l,i_o)*cc(l,i_ho2)
+     $                + c002(l)*cc(l,i_o)*cc(l,i_oh)
+     $                + c003(l)*cc(l,i_h)*cc(l,i_o3)
+     $                + c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                + c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                + c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                + c014(l)*cc(l,i_o3)*cc(l,i_oh)
+     $                + 2.*c015(l)*cc(l,i_o3)*cc(l,i_ho2)
+     $                + c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                + d001(l)*cc(l,i_o)*no2(l)
+c
+         loss(l,i_o2) = j(l,j_o2_o)
+     $                + j(l,j_o2_o1d)
+     $                + a001(l)*cc(l,i_o)
+     $                + c011(l)*cc(l,i_h)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2) = c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                      + c018(l)*cc(l,i_h)*cc(l,i_h)
+c
+         loss(l,i_h2) = b003(l)*cc(l,i_o1d)
+     $                + c010(l)*cc(l,i_oh)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2o
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2o) = 
+     $                   c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                 + c009(l)*cc(l,i_oh)*cc(l,i_h2o2)
+     $                 + c010(l)*cc(l,i_oh)*cc(l,i_h2)
+     $                 + c013(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+         loss(l,i_h2o) = j(l,j_h2o)
+     $                 + b002(l)*cc(l,i_o1d)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        h2o2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_h2o2) =
+     $                    c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                  + c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                  + c017(l)*cc(l,i_oh)*cc(l,i_oh)
+c
+         loss(l,i_h2o2) = j(l,j_h2o2)
+     $                  + c009(l)*cc(l,i_oh)
+     $                  + c012(l)*cc(l,i_o)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hox = h + oh + ho2
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+         production(l,i_hox) = 
+     $                   2.*j(l,j_h2o)*cc(l,i_h2o)
+     $                 + 2.*j(l,j_h2o2)*cc(l,i_h2o2)
+     $                 + 2.*b002(l)*cc(l,i_o1d)*cc(l,i_h2o)
+     $                 + 2.*b003(l)*cc(l,i_o1d)*cc(l,i_h2)
+     $                 + 2.*c012(l)*cc(l,i_o)*cc(l,i_h2o2)
+c
+         loss(l,i_hox) = 2.*c005(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + 2.*c006(l)*cc(l,i_h)*cc(l,i_ho2)
+     $                 + 2.*c007h(l)*cc(l,i_oh)*cc(l,i_ho2)
+     $                 + 2.*c008(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                 + 2.*c013(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                 + 2.*c016(l)*cc(l,i_ho2)*cc(l,i_ho2)
+     $                 + 2.*c017(l)*cc(l,i_oh)*cc(l,i_oh)
+     $                 + 2.*c018(l)*cc(l,i_h)*cc(l,i_h)
+c
+         loss(l,i_hox) = loss(l,i_hox)/cc(l,i_hox)
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     update number densities
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     long-lived species
+c
+      do l = 1,lswitch-1
+         cc(l,i_co)  = (cc0(l,i_co) + production(l,i_co)*dt)
+     $              /(1. + loss(l,i_co)*dt)
+         cc(l,i_o2)  = (cc0(l,i_o2) + production(l,i_o2)*dt)
+     $              /(1. + loss(l,i_o2)*dt)
+         cc(l,i_h2)  = (cc0(l,i_h2) + production(l,i_h2)*dt)
+     $              /(1. + loss(l,i_h2)*dt)
+         cc(l,i_h2o2)= (cc0(l,i_h2o2) + production(l,i_h2o2)*dt)
+     $              /(1. + loss(l,i_h2o2)*dt)
+         cc(l,i_h2o) = (cc0(l,i_h2o) + production(l,i_h2o)*dt)
+     $              /(1. + loss(l,i_h2o)*dt)
+         cc(l,i_hox) = (cc0(l,i_hox) + production(l,i_hox)*dt)
+     $              /(1. + loss(l,i_hox)*dt)
+      end do
+c
+c     ox species
+c
+      if (sza .le. 95.) then
+         do l = 1,lswitch-1
+            cc(l,i_ox) = (cc0(l,i_ox) + production(l,i_ox)*dt)
+     $                   /(1. + loss(l,i_ox)*dt)
+         end do
+      else
+         do l = 1,lswitch-1
+            cc(l,i_o)  = (cc0(l,i_o) + production(l,i_o)*dt)
+     $                   /(1. + loss(l,i_o)*dt)
+            cc(l,i_o3) = (cc0(l,i_o3) + production(l,i_o3)*dt)
+     $                   /(1. + loss(l,i_o3)*dt)
+            cc(l,i_ox) = cc(l,i_o) + cc(l,i_o3)
+         end do
+      end if 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     end of loop over iterations
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      end do
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     density -> volume mixing ratio conversion
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do iesp = 1,nesp
+         do l = 1,lswitch-1
+            rm(l,iesp) = max(cc(l,iesp)/dens(l), 1.d-30)
+         end do
+      end do
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine phot(lswitch, press, temp, sza, dist_sol, rmo3, j)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "chimiedata.h" 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c       
+      integer lswitch         ! interface level between chemistries
+      real press(nlayermx)             ! pressure (hPa)
+      real temp(nlayermx)              ! temperature (K)
+      real sza                         ! solar zenith angle (deg)
+      real dist_sol                    ! sun distance (AU) 
+      real rmo3(nlayermx)              ! ozone mixing ratio
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real j(nlayermx,nd)              ! interpolated photolysis rates (s-1) 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer icol, ij, indsza, indcol, indozo, indtemp, 
+     $        iozo, isza, it, iztop, l
+c
+      real col(nlayermx)               ! overhead air column   (molecule cm-2)
+      real colo3(nlayermx)             ! overhead ozone column (molecule cm-2)
+      real poids(2,2,2,2)              ! 4D interpolation weights 
+      real tref                        ! temperature  at 1.9 hPa in the gcm (K)
+      real table_temp(ntemp)           ! temperatures at 1.9 hPa in jmars   (K)
+      real cinf, csup, cicol, 
+     $     ciozo, cisza, citemp
+      real colo3min, dp, scaleh
+      real ratio_o3(nlayermx)
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     day/night criterion
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      if (sza .le. 95.) then 
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     temperatures at 1.9 hPa in jmars
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      table_temp(1) = 226.2
+      table_temp(2) = 206.2
+      table_temp(3) = 186.2
+      table_temp(4) = 169.8
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     interpolation in solar zenith angle
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      indsza = nsza - 1
+      do isza = 1,nsza
+         if (szatab(isza) .ge. sza) then
+            indsza = min(indsza,isza - 1)
+            indsza = max(indsza, 1)
+         end if
+      end do
+      cisza = (sza - szatab(indsza))
+     $       /(szatab(indsza + 1) - szatab(indsza))
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     air and ozone columns
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     air column at model top: assign standard value
+c
+      scaleh = 10.
+      iztop = nint(scaleh*log(press(1)/press(lswitch-1)))
+      iztop = min(iztop,200)
+      col(lswitch-1) = colairtab(iztop)
+c
+c     ozone column at model top
+c
+      colo3(lswitch-1) = 0.
+c
+c     air and ozone columns for other levels
+c
+      do l = lswitch-2,1,-1
+         dp = (press(l) - press(l+1))*100.
+         col(l) = col(l+1) + factor*dp
+         col(l) = min(col(l), colairtab(0))
+         colo3(l) = colo3(l+1)
+     $            + factor*(rmo3(l+1) + rmo3(l))*0.5*dp
+      end do
+c
+c     ratio ozone column/minimal theoretical column (ro3 = 7.171e-10)
+c
+      do l = 1,lswitch-1
+         colo3min    = col(l)*7.171e-10
+         ratio_o3(l) = colo3(l)/colo3min
+         ratio_o3(l) = min(ratio_o3(l), table_ozo(nozo)*10.)
+         ratio_o3(l) = max(ratio_o3(l), table_ozo(1)*10.)
+      end do
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     temperature dependence
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     1) search for temperature at 1.9 hPa (tref): vertical interpolation
+c
+c      print*,'****** recherche de T a 1.9 hPa ******'
+      tref = temp(1)
+      do l = (lswitch-1)-1,1,-1
+         if (press(l) .gt. 1.9) then
+            cinf = (press(l) - 1.9)
+     $            /(press(l) - press(l+1))
+            csup = 1. - cinf
+            tref = cinf*temp(l+1) + csup*temp(l)
+c
+c            print*, press(l+1), temp(l+1)
+c            print*, press(l  ), temp(l  )
+c            print*, 'tref = ', tref
+            go to 10
+         end if
+      end do 
+ 10   continue
+c
+c     2) interpolation in temperature
+c
+      tref = min(tref,table_temp(1))
+      tref = max(tref,table_temp(ntemp))
+c
+      do it = 2, ntemp
+         if (table_temp(it) .le. tref) then
+            citemp = (log(tref) - log(table_temp(it)))
+     $              /(log(table_temp(it-1)) - log(table_temp(it)))
+            indtemp = it - 1
+c            print*,'interpolation entre ', table_temp(it), ' et ',
+c     $              table_temp(it-1) 
+c            print*,'indtemp = ', indtemp, ' citemp = ', citemp
+            goto 20
+         end if
+      end do
+  20  continue
+c      print*,'****** fin interpolation en T ********'
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     loop over vertical levels
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+c     interpolation in air column
+c
+         do icol = 0,200
+            if (colairtab(icol) .lt. col(l)) then
+               cicol = (log(col(l)) - log(colairtab(icol)))
+     $                /(log(colairtab(icol-1)) - log(colairtab(icol)))
+               indcol = icol - 1
+               goto 30
+            end if
+         end do
+ 30      continue
+c
+cc    interpolation in ozone column
+c
+         indozo = nozo - 1
+         do iozo = 1,nozo
+            if (table_ozo(iozo)*10. .ge. ratio_o3(l)) then
+               indozo = min(indozo, iozo - 1)
+               indozo = max(indozo, 1)
+            end if
+         end do
+         ciozo = (ratio_o3(l) - table_ozo(indozo)*10.)
+     $          /(table_ozo(indozo + 1)*10. - table_ozo(indozo)*10.)
+c
+c         write(6,'(i2,4e13.4,5f10.4)') 
+c    $         l, press(l), col(l), 
+c    $         colairtab(indcol), colairtab(indcol+1), 
+c    $         colo3(l)/2.687e15, 
+c    $         ratio_o3(l), table_ozo(indozo), table_ozo(indozo+1), 
+c    $         ciozo
+c 
+cc    4-dimensional interpolation weights
+c
+         poids(1,1,1,1) = citemp*(1.-cisza)*cicol*(1.-ciozo)
+         poids(1,1,1,2) = citemp*(1.-cisza)*cicol*ciozo
+         poids(1,1,2,1) = citemp*(1.-cisza)*(1.-cicol)*(1.-ciozo)
+         poids(1,1,2,2) = citemp*(1.-cisza)*(1.-cicol)*ciozo
+         poids(1,2,1,1) = citemp*cisza*cicol*(1.-ciozo)
+         poids(1,2,1,2) = citemp*cisza*cicol*ciozo
+         poids(1,2,2,1) = citemp*cisza*(1.-cicol)*(1.-ciozo)
+         poids(1,2,2,2) = citemp*cisza*(1.-cicol)*ciozo
+         poids(2,1,1,1) = (1.-citemp)*(1.-cisza)*cicol*(1.-ciozo)
+         poids(2,1,1,2) = (1.-citemp)*(1.-cisza)*cicol*ciozo
+         poids(2,1,2,1) = (1.-citemp)*(1.-cisza)*(1.-cicol)*(1.-ciozo)
+         poids(2,1,2,2) = (1.-citemp)*(1.-cisza)*(1.-cicol)*ciozo
+         poids(2,2,1,1) = (1.-citemp)*cisza*cicol*(1.-ciozo)
+         poids(2,2,1,2) = (1.-citemp)*cisza*cicol*ciozo
+         poids(2,2,2,1) = (1.-citemp)*cisza*(1.-cicol)*(1.-ciozo)
+         poids(2,2,2,2) = (1.-citemp)*cisza*(1.-cicol)*ciozo
+c
+cc    4-dimensional interpolation in the lookup table
+c
+         do ij = 1,nd
+           j(l,ij) =
+     $     poids(1,1,1,1)*jphot(indtemp,indsza,indcol,indozo,ij)
+     $   + poids(1,1,1,2)*jphot(indtemp,indsza,indcol,indozo+1,ij)
+     $   + poids(1,1,2,1)*jphot(indtemp,indsza,indcol+1,indozo,ij)
+     $   + poids(1,1,2,2)*jphot(indtemp,indsza,indcol+1,indozo+1,ij)
+     $   + poids(1,2,1,1)*jphot(indtemp,indsza+1,indcol,indozo,ij)
+     $   + poids(1,2,1,2)*jphot(indtemp,indsza+1,indcol,indozo+1,ij)
+     $   + poids(1,2,2,1)*jphot(indtemp,indsza+1,indcol+1,indozo,ij)
+     $   + poids(1,2,2,2)*jphot(indtemp,indsza+1,indcol+1,indozo+1,ij)
+     $   + poids(2,1,1,1)*jphot(indtemp+1,indsza,indcol,indozo,ij)
+     $   + poids(2,1,1,2)*jphot(indtemp+1,indsza,indcol,indozo+1,ij)
+     $   + poids(2,1,2,1)*jphot(indtemp+1,indsza,indcol+1,indozo,ij)
+     $   + poids(2,1,2,2)*jphot(indtemp+1,indsza,indcol+1,indozo+1,ij)
+     $   + poids(2,2,1,1)*jphot(indtemp+1,indsza+1,indcol,indozo,ij)
+     $   + poids(2,2,1,2)*jphot(indtemp+1,indsza+1,indcol,indozo+1,ij)
+     $   + poids(2,2,2,1)*jphot(indtemp+1,indsza+1,indcol+1,indozo,ij)
+     $   + poids(2,2,2,2)*jphot(indtemp+1,indsza+1,indcol+1,indozo+1,ij)
+         end do
+c
+cc    correction for sun distance
+c
+         do ij = 1,nd
+            j(l,ij) = j(l,ij)*(1.52/dist_sol)**2.
+         end do 
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     end of loop over vertical levels
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      end do
+c
+      else
+c
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     night
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do ij = 1,nd
+         do l = 1,lswitch-1
+            j(l,ij) = 0.
+         end do
+      end do
+c
+      end if
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine gcmtochim(zycol, lswitch, nesp, rm)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "tracer.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)! species volume mixing ratio in the gcm
+c
+      integer nesp            ! number of species in the chemistry
+      integer lswitch         ! interface level between chemistries
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     outputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real rm(nlayermx,nesp)   ! species volume mixing ratio 
+c      
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer l,iq
+      logical,save :: firstcall=.true.
+      
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_h2o_vap=0
+! Tracer indexes in the chemistry:
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_co=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_o1d=4
+      integer,parameter :: i_o2=5
+      integer,parameter :: i_o3=6
+      integer,parameter :: i_h=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_oh=9
+      integer,parameter :: i_ho2=10
+      integer,parameter :: i_h2o2=11
+      integer,parameter :: i_h2o=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_hox=14
+      integer,parameter :: i_ox=15
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     co2      =  nqchem_min           
+c     co       =  nqchem_min + 1          
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c
+
+! Fist call initializations
+      if (firstcall) then
+        ! get the indexes of the tracers we'll need
+        do iq=1,nqmx
+          if (noms(iq).eq."co2") then
+            g_co2=iq
+          endif
+          if (noms(iq).eq."co") then
+            g_co=iq
+          endif
+          if (noms(iq).eq."o") then
+            g_o=iq
+          endif
+          if (noms(iq).eq."o1d") then
+            g_o1d=iq
+          endif
+          if (noms(iq).eq."o2") then
+            g_o2=iq
+          endif
+          if (noms(iq).eq."o3") then
+            g_o3=iq
+          endif
+          if (noms(iq).eq."h") then
+            g_h=iq
+          endif
+          if (noms(iq).eq."h2") then
+            g_h2=iq
+          endif
+          if (noms(iq).eq."oh") then
+            g_oh=iq
+          endif
+          if (noms(iq).eq."ho2") then
+            g_ho2=iq
+          endif
+          if (noms(iq).eq."h2o2") then
+            g_h2o2=iq
+          endif
+          if (noms(iq).eq."n2") then
+            g_n2=iq
+          endif
+          if (noms(iq).eq."h2o_vap") then
+            g_h2o_vap=iq
+          endif
+        enddo
+        firstcall=.false.
+      endif ! of if (firstcall)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialise chemical species
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+       rm(l,i_co2)  = max(zycol(l, g_co2),     1.e-30)
+       rm(l,i_co)   = max(zycol(l, g_co),      1.e-30)
+       rm(l,i_o)    = max(zycol(l, g_o),       1.e-30)
+       rm(l,i_o1d)  = max(zycol(l, g_o1d),     1.e-30)
+       rm(l,i_o2)   = max(zycol(l, g_o2),      1.e-30)
+       rm(l,i_o3)   = max(zycol(l, g_o3),      1.e-30)
+       rm(l,i_h)    = max(zycol(l, g_h),       1.e-30)
+       rm(l,i_h2)   = max(zycol(l, g_h2),      1.e-30)
+       rm(l,i_oh)   = max(zycol(l, g_oh),      1.e-30)
+       rm(l,i_ho2)  = max(zycol(l, g_ho2),     1.e-30)
+       rm(l,i_h2o2) = max(zycol(l, g_h2o2),    1.e-30)
+       rm(l,i_n2)   = max(zycol(l, g_n2),      1.e-30)
+       rm(l,i_h2o)  = max(zycol(l, g_h2o_vap), 1.e-30)
+c 
+      end do 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     initialise chemical families                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         rm(l,i_hox) = rm(l,i_h) 
+     $               + rm(l,i_oh)
+     $               + rm(l,i_ho2)
+         rm(l,i_ox)  = rm(l,i_o) 
+     $               + rm(l,i_o3)
+      end do
+c
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chimtogcm(zycol, lswitch, nesp, rm)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include"tracer.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer nesp               ! number of species in the chemistry
+      integer lswitch            ! interface level between chemistries
+c      
+      real rm(nlayermx,nesp)     ! species volume mixing ratio 
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     output:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c      
+      real zycol(nlayermx,nqmx)  ! species volume mixing ratio in the gcm
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer l,iq
+      logical,save :: firstcall=.true.
+      
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_h2o_vap=0
+! Tracer indexes in the chemistry:
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_co=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_o1d=4
+      integer,parameter :: i_o2=5
+      integer,parameter :: i_o3=6
+      integer,parameter :: i_h=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_oh=9
+      integer,parameter :: i_ho2=10
+      integer,parameter :: i_h2o2=11
+      integer,parameter :: i_h2o=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_hox=14
+      integer,parameter :: i_ox=15
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     tracers numbering in the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+c     co2      =  nqchem_min
+c     co       =  nqchem_min + 1
+c     o        =  nqchem_min + 2
+c     o(1d)    =  nqchem_min + 3
+c     o2       =  nqchem_min + 4
+c     o3       =  nqchem_min + 5
+c     h        =  nqchem_min + 6
+c     h2       =  nqchem_min + 7
+c     oh       =  nqchem_min + 8
+c     ho2      =  nqchem_min + 9
+c     h2o2     =  nqchem_min + 10
+c     n2       =  nqchem_min + 11
+c     ar       =  nqchem_min + 12
+c     h2o      =  nqmx
+c      
+! Fist call initializations
+      if (firstcall) then
+        ! get the indexes of the tracers we'll need
+        do iq=1,nqmx
+          if (noms(iq).eq."co2") then
+            g_co2=iq
+          endif
+          if (noms(iq).eq."co") then
+            g_co=iq
+          endif
+          if (noms(iq).eq."o") then
+            g_o=iq
+          endif
+          if (noms(iq).eq."o1d") then
+            g_o1d=iq
+          endif
+          if (noms(iq).eq."o2") then
+            g_o2=iq
+          endif
+          if (noms(iq).eq."o3") then
+            g_o3=iq
+          endif
+          if (noms(iq).eq."h") then
+            g_h=iq
+          endif
+          if (noms(iq).eq."h2") then
+            g_h2=iq
+          endif
+          if (noms(iq).eq."oh") then
+            g_oh=iq
+          endif
+          if (noms(iq).eq."ho2") then
+            g_ho2=iq
+          endif
+          if (noms(iq).eq."h2o2") then
+            g_h2o2=iq
+          endif
+          if (noms(iq).eq."n2") then
+            g_n2=iq
+          endif
+          if (noms(iq).eq."h2o_vap") then
+            g_h2o_vap=iq
+          endif
+        enddo
+        firstcall=.false.
+      endif ! of if (firstcall)
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     save mixing ratios for the gcm
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+         zycol(l, g_co2)     = rm(l,i_co2) 
+         zycol(l, g_co)      = rm(l,i_co) 
+         zycol(l, g_o)       = rm(l,i_o) 
+         zycol(l, g_o1d)     = rm(l,i_o1d)
+         zycol(l, g_o2)      = rm(l,i_o2) 
+         zycol(l, g_o3)      = rm(l,i_o3) 
+         zycol(l, g_h)       = rm(l,i_h)  
+         zycol(l, g_h2)      = rm(l,i_h2) 
+         zycol(l, g_oh)      = rm(l,i_oh) 
+         zycol(l, g_ho2)     = rm(l,i_ho2) 
+         zycol(l, g_h2o2)    = rm(l,i_h2o2)
+         zycol(l, g_n2)      = rm(l,i_n2)
+         zycol(l, g_h2o_vap) = rm(l,i_h2o)
+      end do 
+c
+c  water ice: zycol(nqmx-1) has not been changed if iceparty on
+! not an issue anymore since we now use tracer names ...
+! and not relevant anymore as we removed iceparty: water=>iceparty
+c  
+      return
+      end
+c
+c*****************************************************************
+c
+      subroutine chemrates(lswitch, dens, press, t, icesurf,
+     $                     a001, a002, a003,
+     $                     b001, b002, b003, b004, b005, b006,
+     $                     c001, c002, c003, c004, c005, c006,
+     $                     c007, c008, c009, c010, c011, c012,
+     $                     c013, c014, c015, c016, c017, c018,
+     $                     d001, d002, d003,
+     $                     e001, e002,
+     $                     h001, h002)
+c
+c*****************************************************************
+c
+      implicit none
+c
+#include "dimensions.h"
+#include "dimphys.h"
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     inputs:                                                    c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      integer lswitch                  ! interface level between chemistries
+
+      real dens(nlayermx)              ! density (cm-3)
+      real press(nlayermx)             ! pressure (hpa)
+      real t(nlayermx)                 ! temperature (k)
+      real icesurf(nlayermx)           ! ice surface area (cm^2/cm^3)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     outputs:                                                   c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real a001(nlayermx), a002(nlayermx), a003(nlayermx)
+      real b001(nlayermx), b002(nlayermx), b003(nlayermx), 
+     $     b004(nlayermx), b005(nlayermx), b006(nlayermx)
+      real c001(nlayermx), c002(nlayermx), c003(nlayermx), 
+     $     c004(nlayermx), c005(nlayermx), c006(nlayermx), 
+     $     c007(nlayermx), c008(nlayermx), c009(nlayermx), 
+     $     c010(nlayermx), c011(nlayermx), c012(nlayermx),
+     $     c013(nlayermx), c014(nlayermx), c015(nlayermx), 
+     $     c016(nlayermx), c017(nlayermx), c018(nlayermx)
+      real d001(nlayermx), d002(nlayermx), d003(nlayermx)
+      real e001(nlayermx), e002(nlayermx)
+      real h001(nlayermx), h002(nlayermx)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     local:                                                     c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      real ak0, ak1, rate, xpo
+c
+      integer l
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c     compute reaction rates from JPL 1997, otherwise mentioned
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+      do l = 1,lswitch-1
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        oxygen compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      a001: o + o2 + co2 -> o3 + co2
+c
+c        jpl 2003
+c
+         a001(l) = 2.5
+     $             *6.0e-34*(t(l)/300.)**(-2.4)*dens(l)
+c
+c        nair et al., 1994
+c
+c        a001(l) = 1.3e-34*exp(724./t(l))*dens(l)
+c
+ccc      a002: o + o + co2 -> o2 + co2
+c
+c        Tsang and Hampson, J. Chem. Phys. Ref. Data, 15, 1087, 1986
+c
+         a002(l) = 2.5*5.2e-35*exp(900./t(l))*dens(l)
+c
+c        Campbell and Gray, Chem. Phys. Lett., 18, 607, 1973
+c
+c        a002(l) = 1.2e-32*(300./t(l))**(2.0)*dens(l)
+c
+ccc      a003: o + o3 -> o2 + o2
+c
+c        jpl 2003
+c
+         a003(l) = 8.0e-12*exp(-2060./t(l))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        reactions with o(1d)
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      b001: o(1d) + co2  -> o + co2
+c
+c        jpl 2003
+c
+         b001(l) = 7.4e-11*exp(120./t(l))
+c
+ccc      b002: o(1d) + h2o  -> oh + oh
+c
+c        jpl 2003
+c
+         b002(l) = 2.2e-10
+c    
+ccc      b003: o(1d) + h2  -> oh + h
+c
+c        jpl 2003
+c
+         b003(l) = 1.1e-10
+c
+c        nair et al., 1994
+c
+c        b003(l) = 1.0e-10
+c    
+ccc      b004: o(1d) + o2  -> o + o2
+c
+c        jpl 2003
+c
+         b004(l) = 3.2e-11*exp(70./t(l))
+c    
+ccc      b005: o(1d) + o3  -> o2 + o2
+c
+c        jpl 2003
+c
+         b005(l) = 1.2e-10
+c    
+ccc      b006: o(1d) + o3  -> o2 + o + o
+c
+c        jpl 2003
+c
+         b006(l) = 1.2e-10
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        hydrogen compounds    
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      c001: o + ho2 -> oh + o2
+c
+c        jpl 2003
+c 
+         c001(l) = 3.0e-11*exp(200./t(l))
+c        c001(l) = 0.75*3.0e-11*exp(200./t(l))
+c
+ccc      c002: o + oh -> o2 + h
+c
+c        jpl 2003
+c 
+         c002(l) = 2.2e-11*exp(120./t(l))
+c
+ccc      c003: h + o3 -> oh + o2
+c
+c        jpl 2003
+c 
+         c003(l) = 1.4e-10*exp(-470./t(l))
+c
+ccc      c004: h + ho2 -> oh + oh
+c
+c        jpl 2003
+c 
+         c004(l) = 8.1e-11*0.90
+c
+ccc      c005: h + ho2 -> h2 + o2
+c
+c        jpl 2003
+c 
+         c005(l) = 8.1e-11*0.08
+c
+ccc      c006: h + ho2 -> h2o + o
+c
+c        jpl 2003
+c 
+         c006(l) = 8.1e-11*0.02
+c
+ccc      c007: oh + ho2 -> h2o + o2
+c
+c        jpl 2003
+c 
+         c007(l) = 4.8e-11*exp(250./t(l))
+c        c007(l) = 0.75*4.8e-11*exp(250./t(l))
+c
+ccc      c008: ho2 + ho2 -> h2o2 + o2
+c
+c        jpl 2003
+c 
+c        c008(l) = 2.3e-13*exp(600./t(l))
+c
+c        christensen et al., grl, 13, 2002
+c
+         c008(l) = 1.5e-12*exp(19./t(l))
+c
+ccc      c009: oh + h2o2 -> h2o + ho2
+c
+c        jpl 2003
+c 
+         c009(l) = 2.9e-12*exp(-160./t(l))
+c
+ccc      c010: oh + h2 -> h2o + h
+c
+c        jpl 2003
+c 
+         c010(l) = 5.5e-12*exp(-2000./t(l))
+c
+ccc      c011: h + o2 + co2 -> ho2 + co2
+c
+c        jpl 2003
+c 
+         ak0 = 2.5*5.7e-32*(t(l)/300.)**(-1.6)
+         ak1 = 7.5e-11*(t(l)/300.)**(0.0)
+c
+         rate = (ak0*dens(l))/(1. + ak0*dens(l)/ak1)
+         xpo = 1./(1. + alog10((ak0*dens(l))/ak1)**2)
+         c011(l) = rate*0.6**xpo
+c
+ccc      c012: o + h2o2 -> oh + ho2
+c
+c        jpl 2003
+c 
+         c012(l) = 1.4e-12*exp(-2000./t(l))
+c
+ccc      c013: oh + oh -> h2o + o
+c
+c        jpl 2003
+c 
+         c013(l) = 4.2e-12*exp(-240./t(l))
+c
+ccc      c014: oh + o3 -> ho2 + o2
+c
+c        jpl 2003
+c
+         c014(l) = 1.7e-12*exp(-940./t(l))
+c
+c        jpl 2000
+c
+c        c014(l) = 1.5e-12*exp(-880./t(l))
+c
+c        nair et al., 1994 (jpl 1997)
+c
+c        c014(l) = 1.6e-12*exp(-940./t(l))
+c
+ccc      c015: ho2 + o3 -> oh + o2 + o2
+c
+c        jpl 2003
+c
+         c015(l) = 1.0e-14*exp(-490./t(l))
+c
+c        jpl 2000
+c
+c        c015(l) = 2.0e-14*exp(-680./t(l))
+c
+c        nair et al., 1994 (jpl 1997)
+c
+c        c015(l) = 1.1e-14*exp(-500./t(l))
+c
+ccc      c016: ho2 + ho2 + co2 -> h2o2 + o2 + co2
+c
+c        jpl 2003
+c
+         c016(l) = 2.5*1.7e-33
+     $              *exp(1000./t(l))*dens(l)
+c
+ccc      c017: oh + oh + co2 -> h2o2 + co2
+c
+c        jpl 2003
+c
+         ak0 = 2.5*6.9e-31*(t(l)/300.)**(-1.0)
+         ak1 = 2.6e-11*(t(l)/300.)**(0.0)
+c
+c        jpl 1997
+c
+c        ak0 = 2.5*6.2e-31*(t(l)/300.)**(-1.0)
+c        ak1 = 2.6e-11*(t(l)/300.)**(0.0)
+c
+c        nair et al., 1994
+c
+c        ak0 = 2.5*7.1e-31*(t(l)/300.)**(-0.8)
+c        ak1 = 1.5e-11*(t(l)/300.)**(0.0)
+c
+         rate = (ak0*dens(l))/(1. + ak0*dens(l)/ak1)
+         xpo = 1./(1. + alog10((ak0*dens(l))/ak1)**2)
+         c017(l) = rate*0.6**xpo
+c
+ccc      c018: h + h + co2 -> h2 + co2
+c
+c        baulch et al., 1992
+c
+         c018(l) = 2.5*8.85e-33*(t(l)/298.)**(-0.6)*dens(l)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        nitrogen compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      d001: no2 + o -> no + o2
+c
+c        jpl 2003
+c
+         d001(l) = 5.6e-12*exp(180./t(l))
+c
+ccc      d002: no + o3 -> no2 + o2
+c
+c        jpl 2003
+c
+         d002(l) = 3.0e-12*exp(-1500./t(l))
+c
+ccc      d003: no + ho2 -> no2 + oh
+c
+c        jpl 2003
+c
+         d003(l) = 3.5e-12*exp(250./t(l))
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        carbon compounds
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      e001: oh + co -> co2 + h
+c
+c        jpl 2003
+c
+c        e001(l) = 1.5e-13*(1 + 0.6*press(l)/1013.)
+c
+c        mccabe et al., grl, 28, 3135, 2001
+c
+         e001(l) = 1.57e-13 + 3.54e-33*dens(l)
+c
+ccc      e002: o + co + m -> co2 + m
+c
+c        tsang and hampson, 1986.
+c
+         e002(l) = 2.5*6.5e-33*exp(-2184./t(l))*dens(l)
+c
+c        baulch et al., butterworths, 1976.
+c
+c        e002(l) = 1.6e-32*exp(-2184./t(l))*dens(l)
+c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c        heterogenous chemistry
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c
+ccc      h001: ho2 + ice surface -> (ho2)ads
+ccc           (ho2)ads + oh -> h2o + o2
+ccc      total : oh + ho2 -> h2o + o2, first order
+ccc         K = h001*[ho2],
+ccc      h001 = (S*v*gamma1)/4. (s-1), v=100*sqrt(3kT/m_ho2) (cm s-1)
+c
+c        cooper and abbatt, 1996
+c
+         h001(l) = icesurf(l) * 25.*sqrt(3*8.31*t(l)/33.) * 0.025
+c         h001(l) = 0.0e0
+c
+ccc      h002: oh + ice surface -> (oh)ads
+ccc           (oh)ads + ho2 -> h2o + o2
+ccc      total : oh + ho2 -> h2o + o2, first order
+ccc         K = h002*[oh],
+ccc      h002 = (S*v*gamma2)/4. (s-1), v=100*sqrt(3kT/m_oh) (cm s-1)
+c
+c        cooper and abbatt, 1996
+c
+         h002(l) = icesurf(l) * 25.*sqrt(3*8.31*t(l)/17.) * 0.03
+c         h002(l) = 0.0e0
+c
+c        write(*,*) "level ",l," / icesurf=",icesurf(l),
+c     $       " / 0.25vg1=",(25.*sqrt(3*8.31*t(l)/33.) * 0.025),
+c     $       " / 0.25vg2=",(25.*sqrt(3*8.31*t(l)/17.) * 0.03)
+c
+      end do
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/thermosphere.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/thermosphere.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/nocompile/thermosphere.F	(revision 46)
@@ -0,0 +1,88 @@
+      subroutine thermosphere(pplev,pplay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+     &     pt,pq,pu,pv,pdt,pdq,
+     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v3.h"
+#include "chimiedata.h"
+#include "conc.h"
+
+
+      INTEGER l,ig
+
+      REAL pplay(ngridmx,nlayermx)
+      real pplev(ngridmx,nlayermx+1)
+      REAL zzlay(ngridmx,nlayermx)
+      real zzlev(ngridmx,nlayermx+1)
+      REAL pt(ngridmx,nlayermx)
+      real zday
+      REAL dist_sol
+      real mu0(ngridmx)
+      real pq(ngridmx,nlayermx,nqmx)
+      real ptimestep
+      real ptime
+      real tsurf(ngridmx)
+      REAL pu(ngridmx,nlayermx),pv(ngridmx,nlayermx)
+      REAL pdt(ngridmx,nlayermx),pdq(ngridmx,nlayermx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)
+      REAL zdtconduc(ngridmx,nlayermx)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+      if (firstcall) then
+        if (.not. tracer) then
+          do l=1,nlayermx
+            do ig=1,ngridmx
+              rnew(ig,l)=r
+              cpnew(ig,l)=cpp
+            enddo
+          enddo
+        endif
+        firstcall= .false.
+      endif
+
+      if (calleuv) then
+        call zerophys(ngridmx*nlayermx,zdteuv)
+        call euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
+     $               mu0,ptimestep,ptime,zday,pq,pdq,zdteuv)
+      endif
+
+      if (callconduct) THEN
+        call zerophys(ngridmx*nlayermx,zdtconduc)
+        call conduction(ptimestep,pplay,pplev,pt,zdteuv,
+     $                   tsurf,zzlev,zzlay,zdtconduc)
+      endif
+
+      if (callmolvis) THEN
+        call zerophys(ngridmx*nlayermx,zdumolvis)
+        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pu,
+     $                   tsurf,zzlev,zzlay,zdumolvis)
+        call zerophys(ngridmx*nlayermx,zdvmolvis)
+        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pv,
+     $                   tsurf,zzlev,zzlay,zdvmolvis)
+      endif
+
+      if (callmoldiff) THEN
+        call zerophys(ngridmx*nlayermx*nqmx,zdqmoldiff)
+        call moldiff(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
+     &                   zzlay,zdteuv,zdtconduc,zdqmoldiff)
+      endif
+
+      return
+      end
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param.h	(revision 46)
@@ -0,0 +1,62 @@
+c***********************************************
+
+c	param.par
+
+c	Parameters for paramhr.f
+c***********************************************
+
+	integer    ninter
+	parameter  (ninter=33)
+
+	integer    nabs
+	parameter  (nabs=6)
+
+	integer    nz2
+	parameter  (nz2=203)
+
+	integer    ninter2
+        parameter  (ninter2=16)
+
+	real       kboltzman                  !cte Boltzman
+	parameter  (kboltzman = 1.381e-16)
+	
+	real       n_avog                    !# de Avogadro
+	parameter  (n_avog = 6.023e23)
+
+	real       gg                        !cte gravitacion
+	parameter  (gg = 6.67259e-8)
+
+	real       masa                      !masa de Marte(g)
+	parameter  (masa = 6.4163e26)
+
+	real       radio
+	parameter  (radio = 3390.)           !radio de Marte(km)
+
+	real       pmco2
+	parameter  (pmco2 = 44.)
+
+	real       pmo3p
+	parameter  (pmo3p = 16.)
+
+	real       pmo2
+	parameter  (pmo2 = 32.)
+
+	real       pmh2o2
+	parameter  (pmh2o2 = 36.)
+
+	real       cpco2
+	parameter  (cpco2=20.0e6)
+
+	real       cpo2
+	parameter  (cpo2=0.9194e7)
+
+	real       cpo3p
+	parameter  (cpo3p=1.30e7)
+
+	integer	   nreact
+	parameter  (nreact=22)
+
+	integer    nzmax
+	parameter  (nzmax=210)
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param_v3.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param_v3.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/aeronomars/param_v3.h	(revision 46)
@@ -0,0 +1,95 @@
+c**********************************************************************
+
+c	param.cmn
+	
+c	fgg     mar 02          first version
+c**********************************************************************
+
+      common/uv/ anchint,crscabsi2,freccen,c123,c1,c2,c12,c23,ch2o2
+     $ ,jabsifotsint,jfotsout,co2crsc195,co2crsc295,fluxtop,t0
+     
+     
+
+
+      real       anchint(ninter)          !widht of each interval
+      real       crscabsi2(nabs,ninter)    !cross section
+      real       freccen(ninter)          !representative wavelenght
+      real       c123(ninter2,nz2)        !column densities (cm^-2)
+                                          !(CO2+O2+O3P)
+      real       c1(nz2)                  !idem (CO2) (cm^-2)
+      real       c2(nz2)                  !idem (O2) (cm^-2)
+      real       c12(nz2)                 !idem (CO2+O2) (cm^-2)
+      real       c23(nz2)                 !idem (O2+O3P) (cm^-2)
+      real       ch2o2(nz2)               !idem (H2O2) (cm^-2)
+      real       jabsifotsint(ninter,nabs,nzmax) !photoabsorption
+                                                 !coefficients (fot/s)
+      real       jfotsout(ninter,nabs,nzmax)
+      real       co2crsc195(9)
+      real       co2crsc295(9)
+      real       fluxtop(ninter)
+      real       t0(nzmax)
+      
+
+
+      common/fotoquimica/  ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,
+     $                     ch13,ch14,ch15,ch18,ch19,ch20,ch21
+     $			   ,jdistot,jdistot_b
+
+      real*8 ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,ch13,ch14,ch15,ch18
+      real*8 ch19,ch20,ch21
+						  !reaction rates
+      real jdistot(nabs,nzmax)    !photodissociation rates
+      real jdistot_b(2,nzmax)
+
+
+
+      common/prod/ Pco2,Po2,Po3p,Pco,Ph,Poh,Pho2,Ph2,Ph2o,Po1d,Ph2o2,
+     $		   Pco2tot,Po2tot,Po3ptot,Pcotot,Phtot,Pohtot,
+     $             Pho2tot,Ph2tot,Ph2otot,Po1dtot,Ph2o2tot
+	
+      real*8 Pco2(nzmax,nreact),Po2(nzmax,nreact),Po3p(nzmax,nreact)
+      real*8 Pco(nzmax,nreact),Ph(nzmax,nreact),Poh(nzmax,nreact)
+      real*8 Pho2(nzmax,nreact),Ph2(nzmax,nreact),Ph2o(nzmax,nreact)
+      real*8 Po1d(nzmax,nreact),Ph2o2(nzmax,nreact)
+      real*8 Pco2tot(nzmax),Po2tot(nzmax),Po3ptot(nzmax),Pcotot(nzmax)
+      real*8 Phtot(nzmax)
+      real*8 Pohtot(nzmax),Pho2tot(nzmax),Ph2tot(nzmax),Ph2otot(nzmax)
+      real*8 Po1dtot(nzmax),Ph2o2tot(nzmax)
+
+
+      common/loss/ Lco2,Lo2,Lo3p,Lco,Lh,Loh,Lho2,Lh2,Lh2o,Lo1d,Lh2o2,
+     $		   Lco2tot,Lo2tot,Lo3ptot,Lcotot,Lhtot,Lohtot,
+     $             Lho2tot,Lh2tot,Lh2otot,Lo1dtot,Lh2o2tot
+	
+      real*8 Lco2(nzmax,nreact),Lo2(nzmax,nreact),Lo3p(nzmax,nreact)
+      real*8 Lco(nzmax,nreact),Lh(nzmax,nreact),Loh(nzmax,nreact)
+      real*8 Lho2(nzmax,nreact),Lh2(nzmax,nreact),Lh2o(nzmax,nreact)
+      real*8 Lo1d(nzmax,nreact),Lh2o2(nzmax,nreact)
+      real*8 Lco2tot(nzmax),Lo2tot(nzmax),Lo3ptot(nzmax),Lcotot(nzmax)
+      real*8 Lhtot(nzmax),Lohtot(nzmax),Lho2tot(nzmax),Lh2tot(nzmax)
+      real*8 Lh2otot(nzmax),Lo1dtot(nzmax),Lh2o2tot(nzmax)
+
+
+      common/vida/ tminco2,tmino2,tmino3p,tminco,tminh,tminoh,tminho2
+     $               ,tminh2,tminh2o,tmino1d,tminh2o2
+
+    	real*8 tminco2(nzmax),tmino2(nzmax),tmino3p(nzmax),tminco(nzmax)
+    	real*8 tminh(nzmax),tminoh(nzmax),tminho2(nzmax),tminh2(nzmax)
+    	real*8 tminh2o(nzmax),tmino1d(nzmax),tminh2o2(nzmax)
+
+
+      common/flujoctes/ fluxtophr,ct1,p1,ct2,p2   
+ 
+      real fluxtophr(ninter)
+      real ct1(ninter),p1(ninter),ct2(ninter),p2(ninter)       
+
+      common/phdisef/ efdisco2, efdiso2, efdish2, efdish2o, efdish2o2
+
+      real efdisco2(ninter), efdiso2(ninter), efdish2o(ninter)
+      real efdish2o2(ninter), efdish2(ninter)
+
+
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cbrt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cbrt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cbrt.F	(revision 46)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgp.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgp.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgp.F	(revision 46)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/cvmgt.F	(revision 46)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/from36.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/from36.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/from36.F	(revision 46)
@@ -0,0 +1,111 @@
+      SUBROUTINE from36(x,nbre,iunit)
+      IMPLICIT NONE
+c====================================================================
+      INTEGER iunit, nbre
+      REAL x(nbre)
+c====================================================================
+      INTEGER i, l
+      INTEGER nbreok, ibaseok, icase
+      REAL xmax, xmin, errcod
+c====================================================================
+      INTEGER lbord
+      PARAMETER (lbord=255)
+      REAL conv(0:lbord)
+c====================================================================     
+      INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxcas=3, maxnbr=100000)
+      PARAMETER(ifact1=ibase**1-1)
+      PARAMETER(ifact2=ibase**2-1)
+      PARAMETER(ifact3=ibase**3-1)
+      CHARACTER*1 base(ibase), fac(maxcas,maxnbr)
+      INTEGER inte(maxcas)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c====================================================================
+      IF (nbre .GT. maxnbr) THEN
+      PRINT*, 'Verifier maxnbr dans from36 (trop petite)'
+      STOP
+      ENDIF
+      DO 10 i = 0, lbord
+   10 conv(i) = 1.0e+33
+c    34  c  10 conv(i) = 1.0e+49
+      DO 20 i = 1, ibase
+      l = ICHAR(base(i))
+   20 conv(l) = FLOAT(i-1)
+c====================================================================
+      READ (iunit,*) nbreok, ibaseok, icase
+        IF (nbre .NE. nbreok) THEN
+          PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre
+          STOP
+        ENDIF
+        IF (ibase .NE. ibaseok) THEN
+          PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase
+          STOP
+        ENDIF
+        IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN
+          PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire', 
+     .             icase
+          STOP
+        ENDIF
+c====================================================================
+      READ (iunit,*) xmin
+      READ (iunit,*) xmax
+        PRINT*,'Xmin et Xmax=', xmin, xmax
+c====================================================================
+      IF (xmin .EQ. xmax) THEN
+        READ(iunit,'(a)')
+        PRINT*, 'Ce champ est constant'
+        DO 30 i = 1, nbre
+   30   x(i) = xmin
+        GO TO 123
+      END IF
+c====================================================================
+      IF (icase .EQ. 1) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact1)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 190 i = 1, nbre
+        x(i) = 0.0
+        DO 191 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  191   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin)
+  190   CONTINUE
+      ELSE IF (icase .EQ. 2) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact2)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 290 i = 1, nbre
+        x(i) = 0.0
+        DO 291 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  291   CONTINUE
+        x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin)
+  290   CONTINUE
+      ELSE IF (icase .EQ. 3) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact3)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 390 i = 1, nbre
+        x(i) = 0.0
+        DO 391 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  391   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin)
+  390   CONTINUE
+      ELSE
+        PRINT*, 'Verfier icase (1, 2 ou 3)'
+        STOP
+      ENDIF
+   91 FORMAT(120a1)
+   92 FORMAT(64(2a1))
+   93 FORMAT(40(3a1))
+c====================================================================
+  123 RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/gather.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/gather.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/gather.F	(revision 46)
@@ -0,0 +1,16 @@
+      SUBROUTINE GATHER(n,a,b,index)
+c
+      IMPLICIT NONE
+C
+      INTEGER n,index(n),i
+      REAL a(n),b(n)
+c
+      DO 100 i=1,n
+        a(i)=b(index(i))
+100   CONTINUE
+c
+      RETURN
+      END
+c
+c     voir aussi vec_gather(v,vindices,count,r)...p.11-14
+c  
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ilsum.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ilsum.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ilsum.F	(revision 46)
@@ -0,0 +1,19 @@
+      FUNCTION ilsum(n, logic, inc)
+c
+      IMPLICIT NONE
+c
+      integer ilsum
+      integer n, inc
+      logical logic((n-1)*inc+1)
+c
+      integer i, in
+c
+      ilsum = 0.
+      in = 1
+      do 10 i = 1, n
+         if (logic(in)) ilsum = ilsum + 1
+         in=in+inc
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ini36.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ini36.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ini36.F	(revision 46)
@@ -0,0 +1,46 @@
+      SUBROUTINE ini36
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c====================================================================
+c-- cette routine fait l'initialisation pour le codage sur base 36
+c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases
+      INTEGER i,j,k,l, ijk, jk
+c====================================================================
+      INTEGER ibase, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36)
+      PARAMETER (ifact1 = ibase-1)
+      PARAMETER (ifact2 = ibase*ibase-1)
+      PARAMETER (ifact3 = ibase*ibase*ibase-1)
+c====================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+c====================================================================
+      CHARACTER*1 base(ibase)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c===================================================================
+      DO 30 i = 1, ibase
+      DO 30 j = 1, ibase
+      DO 30 k = 1, ibase
+      ijk = ( (i-1)*ibase + j-1 )*ibase + k-1
+      word3(ijk) = base(i)//base(j)//base(k)
+   30 CONTINUE
+      DO 20 j = 1, ibase
+      DO 20 k = 1, ibase
+      jk = (j-1)*ibase + k-1
+      word2(jk) = base(j)//base(k)
+   20 CONTINUE
+      DO 10 k = 1, ibase
+      word1(k-1) = base(k)
+   10 CONTINUE
+c===================================================================
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_errioipsl.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_errioipsl.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_errioipsl.F90	(revision 46)
@@ -0,0 +1,219 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE ioipsl_errioipsl
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_getincom.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_getincom.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_getincom.F90	(revision 46)
@@ -0,0 +1,1980 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the run.def file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the run.def file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from run.def
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = 'run.def'
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file='run.def.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of run.def and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE ioipsl_getincom
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_stringop.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_stringop.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ioipsl_stringop.F90	(revision 46)
@@ -0,0 +1,243 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE ioipsl_stringop
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isamax.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isamax.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isamax.F	(revision 46)
@@ -0,0 +1,21 @@
+      function isamax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,isamax,ix
+      real sx((n-1)*incx+1),sxmax,abssx
+c
+      ix=1
+      isamax=1
+      sxmax=ABS(sx(1))
+      do 10 i=1,n-1
+         ix=ix+incx
+         abssx=ABS(sx(ix))
+         if(abssx.gt.sxmax) then
+             sxmax=abssx
+             isamax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isitor.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isitor.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/isitor.F	(revision 46)
@@ -0,0 +1,64 @@
+
+      SUBROUTINE isitor(filename,writeornot,filenum, files)
+
+C--------------------------------------------------------------------
+C Subroutine qui determine si un fichier doit etre ecrit ou non
+C--------------------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     filename: CHARACTER*20 
+C               nom du fichier dont on veut savoir si il doit etre ecrit
+C     writeornot: LOGICAL
+C                 Variable de sortie qui est vraie si le champ doit etre ecrit
+C     filenum: INTEGER
+C              nombre de fichier dans la list files
+C     files: CHARACTER*20 files(100)
+C            c'est la liste des fichier qui doivent etre ecrit et dans
+C            lequel on vas voir si filename y est.
+C
+
+
+      IMPLICIT NONE
+      CHARACTER*20 filename, checkname
+      CHARACTER*1 separator
+      LOGICAL writeornot, check
+      INTEGER iletter, ifile
+      INTEGER filenum
+      CHARACTER*20 files(100)
+
+      writeornot = .FALSE.
+      check = .FALSE.
+      separator = '/'
+
+      DO 6565 iletter = 20,1,-1
+
+        IF (filename(iletter:iletter) .EQ. separator) THEN
+
+          checkname = filename(iletter+1:20)
+    
+        ELSE
+        ENDIF
+ 6565 CONTINUE
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: filename=',filename,
+     &             'checkname=',checkname
+      ENDIF
+
+      DO 6767 ifile = 1,filenum
+
+      IF (files(ifile) .EQ. checkname ) THEN
+       
+      writeornot = .TRUE. 
+
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
+      ENDIF
+
+ 6767 CONTINUE
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismax.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismax.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismax.F	(revision 46)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismin.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismin.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ismin.F	(revision 46)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+	 ix=ix+incx
+	 if(sx(ix).lt.sxmin) then
+	     sxmin=sx(ix)
+	     ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lmdstd.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lmdstd.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lmdstd.h	(revision 46)
@@ -0,0 +1,31 @@
+c=======================================================================
+c   INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+
+      INTEGER bandmax
+      PARAMETER(bandmax=24)
+
+      COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+     $                gentete,gdatedep,gdatefin
+        
+      CHARACTER*100 gtitre    !du champ
+      CHARACTER*20  gunites   !unites du champ
+      CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+      CHARACTER*100 gfichier  !nom du fichier contenant le champ
+      CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+      CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+      CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+      CHARACTER*20  glistfich !liste de champs a sortir
+
+      COMMON/lmdstdnu/ gminimum,gmaximum,
+     $                 gdeltajour(bandmax),gdeltapas(bandmax),
+     $                 gnbetats(bandmax),gnbfich
+
+      REAL    gminimum        ! \    min et max
+      REAL    gmaximum        ! /    du champ
+      INTEGER gnbfich         ! nombre de fichier a sortir
+c  pour les evolutions temporelles:
+      INTEGER gnbetats        ! nombre d'etats par bande
+      INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+      REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+
+c=======================================================================
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lnblnk.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lnblnk.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/lnblnk.F	(revision 46)
@@ -0,0 +1,36 @@
+      INTEGER FUNCTION lnblnk (letter)
+
+C--------------------------------------------------------
+C Fonction qui determine la longeur d'un string sans les
+C blancs qui suivent. Le critere pour determiner la fin du
+C string est, trois blancs de suite
+C---------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     letter: CHARACTER*xxx (xxx < imax)
+C             le string dont on determine la longuer
+C     lnblnk: INTEGER
+C             le nombre de characteres
+C
+C     PARAMETER
+C     +++++++++
+C     imax : INTEGER
+C            le nombre maximale de character que peut contenir le string
+C            a traiter
+
+      IMPLICIT NONE
+      INTEGER i,imax
+      PARAMETER (imax = 256)
+      CHARACTER*256 letter
+
+      i=0
+
+10    i=i+1
+      IF (letter(i:i+3) . EQ . '   ') GOTO 20
+      GOTO 10
+
+20    lnblnk=i-1
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxm.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxm.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxm.F	(revision 46)
@@ -0,0 +1,34 @@
+       SUBROUTINE MXM(A,NAR,B,NAC,C,NBC)
+c
+c
+c    Multiplication of matrix A by matrix B ,and result in matrix C
+c
+c
+c      NAR : number of   rows  for matrix  A and  matrix  C
+c      NAC : number of columns for matrix  A and number of rows
+c                              for matrix  B
+c      NBC : number of columns for matrix  B and  matrix  C
+c
+c
+       IMPLICIT NONE
+c
+       INTEGER  NAR,NAC,NBC, I,J,K
+       REAL     A(NAR,NAC), B(NAC,NBC), C(NAR,NBC)
+c
+       DO 10 J = 1,NBC
+       DO 10 I = 1,NAR
+       C(I,J)=0.
+10     CONTINUE
+c
+       DO 50 J = 1,NBC
+       DO 40 I = 1,NAR
+
+       DO 20 K = 1,NAC
+       C(I,J)  = C(I,J) + A(I,K) * B(K,J)
+20     CONTINUE
+
+40     CONTINUE
+50     CONTINUE
+
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxv.F	(revision 46)
@@ -0,0 +1,20 @@
+      SUBROUTINE MXV(A,NRA,B,NCA,C)
+      IMPLICIT NONE
+
+      INTEGER NRA,NCA
+      REAL A(NRA,NCA), B(NCA), C(NRA)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+         C(I) = 0.
+100   CONTINUE
+c     multiply matrix A and vector B
+      DO 220 J = 1, NCA
+         DO 210 I = 1, NRA
+            C(I) = C(I) + A(I,J)*B(J)
+210     CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxva.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxva.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mxva.F	(revision 46)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(*), SB(*), SC(*)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mywrite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mywrite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/mywrite.F	(revision 46)
@@ -0,0 +1,154 @@
+      SUBROUTINE mywrite(champ,icount,titre,unit,format,nom
+     &                  , entete, date0, date, deltpas, nbeta
+     &                  , deltajour, filenum, files)
+C----------------------------------------------------------
+C Subroutine qui ecrit les fichiers dans le format de transfert
+C vers le LMD.
+C format etabli par Zhao-Xin Li, Frederique Hourdin, Emmanuelle Cohen-Solal,
+C Jan Polcher . Il peut etre utilise pour sortire  des evolutions
+C temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+C le character # place devant le format determine la fin de la 
+C description du champ et permet eventulellement de rajouter
+C des informations (avant le #).
+C le programme de lecture lit , dans la description, les variables
+C qu'il connait et saute apres jusquau #. A partir de la
+C il commence a lire le champ dans le format specifie.
+c------------------------------------------------------------
+C       ARGUMENTS
+C       +++++++++
+C champ: REAL (icount)
+C        champ contenant les valeurs et de longeur icount
+C icount: INTEGER
+C         nombre d'element dans le champ
+C titre: CHARACTER*100
+C        nom d'ecrivant le champ
+C unit: CHARACTER*20
+C       unites du champ
+C format: CHARACTER*20
+C         format dans le quel le champ doit etre ecrit.
+C         au choix:
+C                  - tous les format FORTRAN
+C                  - compactage de L.Li (zxliN) ou N peut valoir 1, 2 ou 3
+C nom: CHARACTER*20
+C      nom du fichier dans le quel le champ sera ecris, eventuellement
+C      avec directory (ex: evol/tsol)
+C entete: CHARACTER*100
+C         une entete du fichier pouvant par exemple decrire le run
+C date0: CHARACTER*8
+C        date de depart de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C date : CHARACTER*8
+C        date de fin de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C deltpas: INTEGER (bandmax)
+C          decript le nombre de pas de temps entre deux sorties pour chamque
+C          bande (necesaire pour les evolutions temporelles)
+C nbeta: INTEGER (bandmax)
+C        donne le nombre d'etas par bande (necesaire pour les evolutions 
+C        temporelles)
+C deltajour: REAL (bandmax)
+C             l'ecart en jours des iscriptions sur chaque bande (necesaire 
+C             pour les evolutions temporelles)
+C filenum: INTEGER
+C          nombre d'elements dans la liste files des champs desires
+C          si filenum = 0 alors tous les champs sont sortis  
+C files: CHARACTER*20 (100)
+C        list des champ que l'on desire sortire
+C
+C        PARAMETER
+C        +++++++++
+C bandmax: INTEGER
+C          le nombre maximale que peut traiter le programme
+C
+
+
+      IMPLICIT NONE
+
+      INTEGER bandmax
+      PARAMETER (bandmax = 24)
+      INTEGER icount,i,imin,imax
+      REAL champ(icount)
+      CHARACTER*100 titre, entete
+      CHARACTER unit*20,nom*80
+      CHARACTER*20 format
+      CHARACTER*8 date0, date
+      INTEGER deltpas(bandmax), nbeta(bandmax)
+      REAL deltajour(bandmax)
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      INTEGER filenum
+      CHARACTER*20 files(100)
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      check = .FALSE.
+
+      IF (filenum .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(nom,writeornot,filenum, files)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+      IF (writeornot) THEN
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) entete(1:lnblnk(entete))
+        WRITE(*,*) titre(1:lnblnk(titre))
+        WRITE(*,*) date0
+        WRITE(*,*) date
+        WRITE(*,*) unit(1:lnblnk(unit))
+        WRITE(*,*) deltpas, nbeta
+        WRITE(*,*) deltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) format(1:lnblnk(format))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) titre(1:lnblnk(titre)),'min,max:',
+     &           champ(imin),champ(imax),'  ',unit(1:lnblnk(unit))
+      
+      OPEN (unit=55, file=nom(1:lnblnk(nom)))
+      WRITE(55,'(a)') entete(1:lnblnk(entete))
+      WRITE(55,'(a)') titre(1:lnblnk(titre))
+      WRITE(55,'(a)') date0
+      WRITE(55,'(a)') date
+      WRITE(55,'(a)') unit(1:lnblnk(unit))
+      WRITE(55,*) deltpas, nbeta
+      WRITE(55,*) deltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//format(1:lnblnk(format))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//format(1:lnblnk(format))//')') champ(1)
+      ENDIF
+
+      IF (format(1:lnblnk(format)) .EQ. 'zxli1') THEN
+        CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+      ELSE 
+        IF (format(1:lnblnk(format)) .EQ. 'zxli2') THEN
+          CALL to36 (champ, icount,champ(imin), champ(imax),55, 2)
+        ELSE
+          IF (format(1:lnblnk(format)) .EQ. 'zxli3') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 3)
+          ELSE
+            DO 2233 i=1,icount
+              WRITE(55,'('//format(1:lnblnk(format))//')') 
+     &             champ(i)
+ 2233       CONTINUE
+          ENDIF
+        ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      ELSE
+        WRITE(*,*) 'FILE    ',nom,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readcoord.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readcoord.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readcoord.F	(revision 46)
@@ -0,0 +1,123 @@
+      SUBROUTINE readcoord(imx,jmx,lmx,imax,jmax,lmax,x,y,z,pathcoor)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs Jan Polcher, Frederic Hourdin
+c   -------
+c
+c   Objet   Lecture du fichier contenant des coordonnees x,y et z.
+c   -----
+c
+c   Inteface
+c   --------
+c
+c   Arguments:
+c   ----------
+c
+c   input
+c   -----
+c      imx   \
+c      jmx          dimensions des coordonnees
+c      lmx   /
+c      pathcoor     path absolu pour le fichier des coordonnees
+c                   CHARACTER*80
+c
+c   ouput
+c   -----
+c      imax         nombre de coordonnees x effectives
+c      jmax         nombre de coordonnees y effectives
+c      lmax         nombre de coordonnees z effectives
+c      x(imx)
+c      y(jmx)
+c      z(lmx)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+      INTEGER imx,jmx,lmx
+      INTEGER imax,jmax,lmax
+
+      REAL x(imx),y(jmx),z(lmx)
+
+      CHARACTER*80 pathcoor
+
+c   local
+c   -----
+
+      INTEGER i,j,l
+
+      CHARACTER*100 filecoor,messerr
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      messerr=' '
+      filecoor='coord.def'
+
+c-----------------------------------------------------------------------
+
+100   IF(pathcoor(1:1).EQ.'/') THEN
+         filecoor= pathcoor(:lnblnk(pathcoor))//filecoor
+      ENDIF
+      OPEN (99,file=filecoor,err=200,status='old',form='formatted')
+      GO TO 300
+
+200   WRITE(*,*) messerr
+      WRITE(*,*) 'entrer le nom du fichier des coordonnees puis RETURN'
+      WRITE(*,*) 'ou seulement RETURN pour arreter le programme'
+      READ(*,'(a)') filecoor
+      IF(filecoor(1:1).EQ.' ') STOP
+      CLOSE (99)
+      GOTO 100
+
+300   CONTINUE
+
+      READ(99,*,err=9999) imax
+      IF(imax.GT.imx) THEN
+        WRITE(6,1000) 'x',imx,imax
+        STOP
+      ENDIF
+      READ(99,*) (x(i),i=1,imax)
+
+      READ(99,*,err=9999) jmax
+      IF(jmax.GT.jmx) THEN
+        WRITE(6,1000) 'y',jmx,jmax
+        STOP
+      ENDIF
+      READ(99,*,err=9999) (y(j),j=1,jmax)
+
+      READ(99,*,err=9999) lmax
+      IF(lmax.GT.lmx) THEN
+        WRITE(6,1000) 'z',lmx,lmax
+        STOP
+      ENDIF
+      READ(99,*) (z(l),l=1,lmax)
+
+      CLOSE(99)
+
+c-----------------------------------------------------------------------
+
+      RETURN
+
+9999  PRINT*,'Le fichier ',filecoor,' que vous lisez est mal structure'
+      PRINT*,'Il doit contenir :'
+      PRINT*,'  le nombre de points en x suivi des valeurs de x'
+      PRINT*,'  puis la meme chose pour y et z'
+      STOP
+
+1000  FORMAT(/,
+     $ 'Probleme avec le fichier de coordonnees',/,
+     $ 'Le tableau contenant ',a3,' est dimenssionne a ',i4,/,
+     $ 'et le fichier de coordonnees contient ',i4,' valeurs.')
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readstd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readstd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/readstd.F	(revision 46)
@@ -0,0 +1,286 @@
+      SUBROUTINE readstd(imx,champ,imax)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin  20/04/91
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui lit les fichiers dans le format lmdstd
+c format etabli par :
+c  Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c imx  : INTEGER
+c        taille du tableau contenant le champ
+c champ: REAL (imx)
+c        champ contenant les valeurs et de longeur icount
+c imax : INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER imx,imax
+      REAL champ(imx)
+
+c   Local:
+c   ------
+
+      INTEGER i
+
+      CHARACTER*200 test(20)
+      CHARACTER*200 helptest(20)
+      CHARACTER*200 help
+      INTEGER reccount
+
+      LOGICAL check,continue
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      check = .FALSE.
+      DO 9876 i=1,20
+        helptest(i) = '        '
+ 9876 CONTINUE
+
+
+c-----------------------------------------------------------------------
+c   lecture le l'entete:
+c   --------------------
+
+ 2222 OPEN (unit=10,file=gfichier(1:lnblnk(gfichier)), form='formatted',
+     &      ERR = 9999, status='old')
+      GOTO 1111
+
+ 9999 WRITE(*,*) 'Je ne peut pas lire le fichier: ',
+     & gfichier(1:lnblnk(gfichier))
+      CLOSE(10)
+      WRITE(*,*) 'Entrez S.V.P. un autre nom de fichier (path absolu) '
+      WRITE(*,*) 'ou RETURN pour stopper lexecution'
+      READ (*,'(a)') gfichier
+      IF(lnblnk(gfichier).EQ.0) STOP
+      GOTO 2222
+
+ 1111 continue = .TRUE.
+      DO 2345 i=1,20
+        IF (continue) THEN
+          READ (10,'(a200)') test(i)
+          IF ( test(i)(1:1) .EQ. '#' .OR. test(i)(1:1) .EQ. 'f10' ) THEN
+            continue = .FALSE.
+            reccount = i
+          ENDIF
+        ENDIF
+ 2345 CONTINUE
+
+      DO 1223 i=1,reccount-1
+        helptest(i) = test(i)
+ 1223 CONTINUE
+      helptest(20) = test(reccount)
+
+
+      IF (check) THEN
+        WRITE(*,*) 'gentete'
+      ENDIF
+      IF ( helptest(1) .NE. ' ' ) THEN
+        read (helptest(1),'(a100)') gentete
+      ELSE
+c       WRITE(*,*) 'la description du run'
+c       READ (*,'(a100)') gentete
+        gentete = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'titre'
+      ENDIF
+      IF ( helptest(2) .NE. ' ' ) THEN
+        read (helptest(2),'(a100)') gtitre
+      ELSE
+c       WRITE(*,*) 'le titre du dessin'
+c       READ (*,'(a100)') gtitre 
+        gtitre = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'datefins'
+      ENDIF
+      IF ( helptest(3) .NE. ' ' ) THEN
+        read (helptest(3),'(a8)') gdatedep 
+        read (helptest(4),'(a8)') gdatefin
+      ELSE
+c       WRITE(*,*)
+c    &  'datefin du debut de la moyenne (ou le mois tout simplement)'
+c       READ (*,'(a8)') gdatedep 
+c       WRITE(*,*) 'et celle de la fin (ou rien du tout)'
+c       READ (*,'(a8)') gdatefin 
+        gdatedep = '       '
+        gdatefin = '       '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'unitees'
+      ENDIF
+      IF ( helptest(5) .NE. ' ' ) THEN
+        read (helptest(5),'(a20)') gunites
+      ELSE
+c       WRITE(*,*) 'les unitees du champ'
+c       READ (*,'(a20)') gunites
+        gunites = '                    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltapas et nbetats'
+      ENDIF
+      IF ( helptest(6) .NE. ' ' ) THEN
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+        GOTO 1213
+
+ 1212   help =helptest(6)(1:lnblnk(helptest(6)))//
+     .        helptest(7)(1:lnblnk(helptest(7)))
+        helptest(6) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1214 i=7,reccount
+          helptest(i) = helptest(i+1)
+ 1214   CONTINUE
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+
+ 1213   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltajour'
+      ENDIF
+      IF ( helptest(7) .NE. ' ' ) THEN
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+        GOTO 1313
+
+ 1312   help =helptest(7)(1:lnblnk(helptest(7)))//
+     .        helptest(8)(1:lnblnk(helptest(8)))
+        helptest(7) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1314 i=8,reccount
+          helptest(i) = helptest(i+1)
+ 1314   CONTINUE
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+
+ 1313   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'min et max'
+      ENDIF
+      IF ( helptest(8) .NE. ' ' ) THEN
+c       READ (helptest(8),*)     gminimum,gmaximum
+      ENDIF
+
+      gformat = helptest(20)(2:20)
+
+      IF (check) THEN
+        WRITE(*,*) gentete
+        WRITE(*,*) gtitre
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin 
+        WRITE(*,*) gdeltapas,gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) gminimum,gmaximum
+        WRITE(*,*) gformat
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   lecture du champ proprement dit:
+c   --------------------------------
+
+      READ (10,*)     imax
+   
+      IF(imax.GT.imx) THEN
+         WRITE(*,*) 'Vous essayez de lire un champ dont la taille est'
+         WRITE(*,*) 'superieure a la taille maximum autorisee'
+         WRITE(*,*) 'c est a dire a la dimension du champ utilise'
+         WRITE(*,*) 'pour lappel a la procedure writestd.'
+         STOP
+      ENDIF
+
+      IF (gformat(1:4) .EQ. 'zxli') THEN
+        CALL from36 (champ,imax,10)
+      ELSE 
+         IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+            READ(10,*) (champ (i),i=1,imax)
+         ELSE
+            READ(10,'('//gformat(1:lnblnk(gformat))//')')
+     $      (champ (i),i=1,imax)
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=10)
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scatter.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scatter.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scatter.F	(revision 46)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopy.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopy.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopy.F	(revision 46)
@@ -0,0 +1,17 @@
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopyi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopyi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/scopyi.F	(revision 46)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/sdot.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/sdot.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/sdot.F	(revision 46)
@@ -0,0 +1,21 @@
+      FUNCTION sdot (n, x,incx, y,incy)
+      IMPLICIT NONE
+c
+      integer n, incx, incy
+      real sdot
+      real x((n-1)*incx+1), y((n-1)*incy+1)
+c
+      integer i, ix, iy
+c
+      sdot = 0.0
+      ix = 1
+      iy = 1
+c
+      do 10 i = 1, n
+         sdot = sdot + x(ix) * y(iy)
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ssum.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ssum.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/ssum.F	(revision 46)
@@ -0,0 +1,16 @@
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+      ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/to36.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/to36.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/to36.F	(revision 46)
@@ -0,0 +1,84 @@
+      SUBROUTINE to36(x,nbre,xmin,xmax,iunit,icase)
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c=======================================================================
+c-- x    : le champ a compacter
+c-- nbre : la taille du champ x
+c-- iunit: numero logique du fichier sortie
+c-- icase: nombre de cases a utiliser (qui determine la precision)
+      INTEGER iunit, nbre, icase
+      REAL x(nbre) 
+c=======================================================================
+      INTEGER ibase, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxnbr=100000)
+      PARAMETER (ifact1 = ibase**1-1)
+      PARAMETER (ifact2 = ibase**2-1)
+      PARAMETER (ifact3 = ibase**3-1)
+c=======================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*1 chax1(maxnbr)
+c======================================================================
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*2 chax2(maxnbr)
+c======================================================================
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+      CHARACTER*3 chax3(maxnbr)
+c=====================================================================
+      INTEGER i, inte
+      REAL xmin, xmax
+      EXTERNAL ini36
+c=====================================================================
+c
+c--- initialisation pour le codage
+c la routine ini36 est appelee une seule fois
+c     IF (word1(36) .NE. 'Z' ) THEN
+        CALL ini36
+c     ENDIF
+
+      IF (nbre .GT. maxnbr) THEN
+        PRINT*, 'Nombre elements trop grand', nbre, maxnbr
+        STOP
+      ENDIF
+c
+      WRITE(iunit,*) nbre, ibase, icase, '  (nbre,ibase,icase)'
+      WRITE(iunit,*) xmin
+      WRITE(iunit,*) xmax
+c
+      IF(xmin .EQ. xmax)THEN
+      WRITE(iunit,'(a)')'Ce champ est constant'
+      GO TO 999
+      ENDIF 
+c
+      IF (icase .EQ. 1) THEN
+        DO 10 i = 1, nbre
+          inte = NINT( FLOAT(ifact1)/(xmax-xmin) * (x(i)-xmin) )
+          chax1(i) = word1(inte)
+   10   CONTINUE
+        WRITE(iunit,91) (chax1(i),i=1,nbre)
+      ELSE IF (icase .EQ. 2) THEN
+        DO 20 i = 1, nbre
+          inte = NINT( FLOAT(ifact2)/(xmax-xmin) * (x(i)-xmin) )
+          chax2(i) = word2(inte)
+   20   CONTINUE
+        WRITE(iunit,92) (chax2(i),i=1,nbre)
+      ELSE IF (icase.eq.3) THEN
+        DO 30 i = 1, nbre
+          inte = NINT( FLOAT(ifact3)/(xmax-xmin) * (x(i)-xmin) )
+          chax3(i) = word3(inte)
+   30   CONTINUE
+        WRITE(iunit,93) (chax3(i),i=1,nbre)
+      ELSE
+        PRINT*, 'Verfier icase (1,2,3) dans les arguments de to36'
+        STOP
+      ENDIF
+c
+   91 FORMAT(120a1)
+   92 FORMAT(64a2)
+   93 FORMAT(40a3)
+c
+  999 RETURN
+      END 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/wheneq.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/wheneq.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/wheneq.F	(revision 46)
@@ -0,0 +1,23 @@
+      SUBROUTINE wheneq(n,x,incx,target,index,nn)
+      IMPLICIT NONE
+c
+      integer n, incx, nn
+      integer index(n)
+c
+      integer target, x((n-1)*incx+1)
+cccccc      real target, x((n-1)*incx+1)
+c
+      integer i, ix
+c
+      ix = 1
+      nn = 0
+      do 10 i = 1, n
+         if (x(ix).EQ.target) then
+            index(i) = ix
+            nn = nn + 1
+         endif
+         ix = ix + incx
+   10 continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/writestd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/writestd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/bibio/writestd.F	(revision 46)
@@ -0,0 +1,200 @@
+      SUBROUTINE writestd(champ,icount)
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui ecrit les fichiers dans le format de transfert
+c vers le LMD.
+c format etabli par :
+c   Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c   Jan Polcher .
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c champ: REAL (icount)
+c        champ contenant les valeurs et de longeur icount
+c icount: INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER icount
+      REAL champ(icount)
+
+c   Local:
+c   ------
+
+      INTEGER i,imin,imax
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      INTEGER indexfil
+      COMMON/indexfil/indexfil
+
+c-----------------------------------------------------------------------
+c   verification que le champ est dans la liste predefinie:
+c   -------------------------------------------------------
+
+      check = .FALSE.
+
+      IF (gnbfich .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(gfichier,writeornot,gnbfich, glistfich)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+c-----------------------------------------------------------------------
+      IF (writeornot) THEN
+c-----------------------------------------------------------------------
+
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) gentete(1:lnblnk(gentete))
+        WRITE(*,*) gtitre(1:lnblnk(gtitre))
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin
+        WRITE(*,*) gunites(1:lnblnk(gunites))
+        WRITE(*,*) gdeltapas, gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) gformat(1:lnblnk(gformat))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) gtitre(1:lnblnk(gtitre)),'min,max:',
+     &  champ(imin),champ(imax),'  ',gunites(1:lnblnk(gunites))
+      
+c-----------------------------------------------------------------------
+c   creation eventuelle d'un nom pour le fichier d'ecriture du champ:
+c   -----------------------------------------------------------------
+
+      IF(lnblnk(gfichier).LT.1.OR.lnblnk(gfichier).GE.100) THEN
+         gfichier(1:5)='champ'
+         IF(indexfil.LT.1) indexfil=49
+         gfichier(6:6)=char(indexfil)
+	 indexfil=indexfil+1
+	 PRINT*,'nom du fichier  ',gfichier
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   ecriture sur le fichier de sorties:
+c   -----------------------------------
+
+      OPEN (unit=55, file=gfichier(1:lnblnk(gfichier)))
+      WRITE(55,'(a)') gentete(1:lnblnk(gentete))
+      WRITE(55,'(a)') gtitre(1:lnblnk(gtitre))
+      WRITE(55,'(a)') gdatedep
+      WRITE(55,'(a)') gdatefin
+      WRITE(55,'(a)') gunites(1:lnblnk(gunites))
+      WRITE(55,*) gdeltapas, gnbetats
+      WRITE(55,*) gdeltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//gformat(1:lnblnk(gformat))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//gformat(1:lnblnk(gformat))//')') champ(1)
+      ENDIF
+
+      IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+         DO 2230 i=1,icount
+            WRITE(55,*) champ(i)
+2230     CONTINUE
+      ELSE
+         IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli1') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+         ELSE 
+            IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli2') THEN
+               CALL to36(champ,icount,champ(imin),champ(imax),55,2)
+            ELSE
+               IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli3') THEN
+                  CALL to36(champ,icount,champ(imin),champ(imax),55,3)
+               ELSE
+                  WRITE(55,'('//gformat(1:lnblnk(gformat))//')') 
+     &            (champ(i),i=1,icount)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      gfichier=' '
+
+c-----------------------------------------------------------------------
+c   si on ecrit pas le champ (writeornot.EQ..f.):
+c   ---------------------------------------------
+
+      ELSE
+        WRITE(*,*) 'FILE    ',gfichier,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate1	(revision 46)
@@ -0,0 +1,14 @@
+\rm aeronomars/d2_*
+\rm bibio/d2_*
+\rm phymars/d2_*
+\rm grid/d2_*
+\rm dyn3d/d2_*
+
+\rm aeronomars/d3_*
+\rm bibio/d3_*
+\rm phymars/d3_*
+\rm grid/d3_*
+\rm dyn3d/d3_*
+
+
+# this may be used for cleaning purpose as well
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate2	(revision 46)
@@ -0,0 +1,43 @@
+#!/bin/bash
+
+echo 'duplicate sources for domain 2'
+
+\rm aeronomars/d2_*
+\rm bibio/d2_*
+\rm phymars/d2_*
+\rm grid/d2_*
+\rm dyn3d/d2_*
+
+
+cd aeronomars
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd bibio
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd phymars
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+cd grid
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+\rm d2_dimension
+cd ..
+
+cd dyn3d
+cp ../generate2 .
+find * -exec generate2 {} \;
+\rm *generate2
+cd ..
+
+  
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate3
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate3	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate3	(revision 46)
@@ -0,0 +1,57 @@
+#!/bin/bash
+
+./duplicate2
+
+echo 'duplicate sources for domain 3'
+
+\rm aeronomars/d3_*
+\rm bibio/d3_*
+\rm phymars/d3_*
+\rm grid/d3_*
+\rm dyn3d/d3_*
+
+
+cd aeronomars
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd bibio
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd phymars
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+cd grid
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+\rm d3_dimension
+cd ..
+
+cd dyn3d
+cp ../generate3 .
+find * -exec generate3 {} \;
+\rm *generate3
+cd ..
+
+\rm aeronomars/d3_d2*
+\rm bibio/d3_d2*
+\rm phymars/d3_d2*
+\rm grid/d3_d2*
+\rm dyn3d/d3_d2*
+
+\rm aeronomars/d2_d3*
+\rm bibio/d2_d3*
+\rm phymars/d2_d3*
+\rm grid/d2_d3*
+\rm dyn3d/d2_d3*
+
+  
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate4
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate4	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/duplicate4	(revision 46)
@@ -0,0 +1,69 @@
+#!/bin/bash
+
+./duplicate3  ## est-ce le bon ordre ??? 
+
+echo 'duplicate sources for domain 4'
+
+\rm aeronomars/d4_*
+\rm bibio/d4_*
+\rm phymars/d4_*
+\rm grid/d4_*
+\rm dyn3d/d4_*
+
+
+cd aeronomars
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd bibio
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd phymars
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+cd grid
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+\rm d3_dimension
+cd ..
+
+cd dyn3d
+cp ../generate4 .
+find * -exec generate4 {} \;
+\rm *generate4
+cd ..
+
+\rm aeronomars/d4_d3*
+\rm bibio/d4_d3*
+\rm phymars/d4_d3*
+\rm grid/d4_d3*
+\rm dyn3d/d4_d3*
+
+\rm aeronomars/d3_d4*
+\rm bibio/d3_d4*
+\rm phymars/d3_d4*
+\rm grid/d3_d4*
+\rm dyn3d/d3_d4*
+
+\rm aeronomars/d4_d2*
+\rm bibio/d4_d2*
+\rm phymars/d4_d2*
+\rm grid/d4_d2*
+\rm dyn3d/d4_d2*
+
+\rm aeronomars/d2_d4*
+\rm bibio/d2_d4*
+\rm phymars/d2_d4*
+\rm grid/d2_d4*
+\rm dyn3d/d2_d4*
+
+  
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/LISEZMOI
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/LISEZMOI	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/LISEZMOI	(revision 46)
@@ -0,0 +1,136 @@
+
+Version abbrégé spécial Mars
+
+ ..  Version  du 28/12/1998  , avec  nouveau fxyhyper appele par inigeom ...
+ **************************************************************************
+
+ 1) Le gcm LMDZ.3.2  a des coordonnees  hybrides  verticalement ,c.a.d  des
+          ********
+   coordonnees equivalentes a sigma pres de la surface et a  P plus haut .     
+
+   Les pressions  p(ij,l) aux differents interfaces des  llm  couches verti- 
+   cales sont donnees  par   :
+
+    p( ij,l ) = ap(l) + bp(l) * ps(ij)    ,    1 << l << llm + 1    . 
+
+            
+   La fonction d'Exner  est calculee aux milieux des llm couches vertic.
+
+     pk(ij,l) = cp * ( p(ij,l)/preff ) ** kappa   ,  1 << l <<  llm
+
+   Les pressions  PLS(ij,l)  definies aux milieux des couches sont egales a :
+
+     pls(ij,l) = preff * ( pk(ij,l) /cp ) ** 1./kappa
+
+   
+
+ 2) Une des variables prognostiques de LMDZ.3  est   teta  , temperature 
+     potentielle  :    
+
+                 teta (ij,l) = temperature(ij,l) * cp/ pk(ij,l)
+ 
+    
+ 3) Dans  le programme principal gcm.F , il faut definir , au debut ,les para-
+    metres  IADV ,pour choisir le shema d'advection pour l'eau et les traceurs
+                    IADV = 3    , Van-Leer
+
+ 4) Il y a 2 shemas de dissipation   ( diffusion laterale )  :
+
+ a) La dissipation star ( qui ne fait pas intervenir la geometrie de la     
+    grille et qui est utilisee quand il y a un zoom ) 
+
+    Par expl . la diffusion d'un scalaire  comme  teta est formulee ( en 
+     appelant l'operateur  DIVGRAD2 )   comme :
+
+    d( ro * teta ) = (-1)**(it-1) *cdiv * Lap * ro**1/2 * Lap_gam** (it-2 ) *
+                           ro**1/2 * Lap * teta
+ avec  :
+ Lap     = 1/aire * Filt[ dx ( coefx*dx ) + dy( coefy*dy ) ] Filt
+       
+ Lap_gam = (1./aire)** -gam { dx[ coefx**(-gam) dx] + dy[ coefy**(-gam) dy ] } 
+
+
+  Filt est l'operateur  filtre 
+  ro   est la densite dp  de chaque couche
+  it   = nombre d'iterations de l'operateur de dissipation ( ici divgrad2 )
+  gam  = coefdis /( it -2 ) , coefdis = 0. si it = 2 , sinon = 1. habituellem.
+  dx   = operateur difference finie :
+    dx(A) = A( X +1/2 , Y, z ) - A( X -1/2, Y, z ) , dans le systeme de 
+  travail  (X,Y) , avec l'increment DX = 1.
+
+  Idem pour dy .
+
+  coefx = beta(ij) / alpha(ij)  , coefy = alpha(ij)/beta(ij)
+     avec    u_covariant(ij) = alpha(ij)* u_nat(ij) 
+             v_covariant(ij) = beta(ij) * v_nat(ij) 
+
+ Cette dissipation star est choisie en mettant le parametre lstardis a .TRUE.
+  dans le fichier run.def  lu  par le gcm en entree .
+
+ b) La dissipation ' non star '  fait intervenir les operateurs elementaires
+   diverg,grad,rotat .   Elle est choisie  avec lstardis = .FALSE.
+
+N.B : Dans les 2 shemas de dissipation , le gcm est plus stable  quand on
+     n'itere pas l'operateur ' GRADIV ' ou ' GRADIV2 " .            
+     
+ 5) Les constantes thermodynamiques Cp et kappa = R/Cp   utilisees dans la
+   partie dynamique ont ete mises , ce qui est normal, aux memes valeurs
+   qu'elles ont dans la partie ' physique ' , en changeant INICONST et en 
+   les mettant dans l'entete de controle de start et startphy ,en changeant
+   etat0_lmd , par rapport  a LMDZ.2.2 
+       
+ 6) Pour finir , quelques commentaires sur les parametres qui figurent sur
+    le fichier  run.def qui commandent le gcm .
+
+
+ c) coefdis , coefficient qui intervient dans le calcul de gam  , utilise 
+   dans les routines de dissipation star , vus plus haut .
+
+ d) iphysiq correspond ici a un appel de la physique toutes les 30 minutes.
+
+ e) alphax et alphay correspondent au grossissement pour le zoom dans la
+   direction X et Y .
+   En fait , les facteurs de grossissement sont egaux a  1./ ( 1.- alphax )
+     et 1./( 1.- alphay )  .
+
+ f) fxyhypb  est egal a .TRUE. si on choisit  pour la fonction f(x,y) qui 
+   definit la grille du modele  une fonction a tangente hyperbolique , un peu
+   adaptee pour le zoom , que la fonction sinusoidale , definie par fxy_new.h 
+   dans /..../gcm/libf/grid  et lu par  makegcm  lors de la compilation du 
+   code .
+
+
+N.B: Pour l'instant , cette fonction hyperbolique n'est activee eventuellement
+****            que pour  un zoom  latitudinal . 
+   Pour un zoom longitudinal , la fonction sinusoidale precisee dans fxy_new.h
+       est  choisie automatiquement .
+
+ g) psi0 et delta sont des parametres  pour cette fonction hyberbolique .
+   Ces valeurs de 0.3 et 0.5  ont ete adaptees pour 96x72  .
+  
+
+
+
+ ****************************************************************************
+
+ 
+ AA) Choisir les options du run  , avec   le fichier  run.def   .
+
+     Il y a entre autres choses , le nombre de jours qu'on veut integrer lors 
+       d'un run .
+     Il y a le nombre de pas a faire pour 1 jour , ce qui calcule donc le dt
+       temporel ( en secondes ) pour un pas dynamique .
+     Iperiod  est conseille  d'etre a 5 pas ( mais non obligatoiremnet = 5 ) . 
+     Idissip  peut etre mis a n'importe quelle valeur . Il est maintenant
+
+     Les parametres( la plupart des cles ) pour la physique commencent avec
+      la var. logique         **  physic  **
+
+           entiere( en pas )  ** iphysiq  ** qui est calculee de telle facon a
+                              appeler la physique tous les  30 minutes .
+
+           ( en jours )       ** ecritphy ** qui indique la frequence en jours
+                                du stockage   sur  diagfi
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/advtrac.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/advtrac.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/advtrac.h	(revision 46)
@@ -0,0 +1,7 @@
+!
+! Tracers in the dynamics (E.M, oct.2008)
+!
+      COMMON/advtr/iadv,tnom
+      INTEGER :: iadv(nqmx)           ! tracer advection scheme number
+      CHARACTER (len=20) :: tnom(nqmx) ! tracer name
+      ! NB: tnom length should be compatible with noms() in physics ...
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/angtot.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/angtot.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/angtot.h	(revision 46)
@@ -0,0 +1,8 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'angtot.h
+
+      COMMON/angtot/dangdyn,dangm1,dangdis,dangdif
+
+      REAL dangdyn,dangm1,dangdis,dangdif
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/clesph0.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/clesph0.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/clesph0.h	(revision 46)
@@ -0,0 +1,8 @@
+c..include clesph0.h
+c
+       COMMON/clesph0/cycle_diurne, soil_model,new_oliq, ok_orodr ,
+     ,                ok_orolf ,ok_limitvrai, nbapp_rad, iflag_con
+c
+       LOGICAL cycle_diurne,soil_model,ok_orodr,ok_orolf,new_oliq
+       LOGICAL ok_limitvrai
+       INTEGER nbapp_rad, iflag_con
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comav.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comav.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comav.h	(revision 46)
@@ -0,0 +1,3 @@
+      COMMON/comav/period_av,time0_av
+      REAL period_av ! periode de stockage en jour
+      REAL time0_av  ! date initiale de stokage en jour
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comconst.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comconst.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comconst.h	(revision 46)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+! INCLUDE comconst.h
+
+      COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,
+     * dtvr,daysec,
+     * pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
+
+      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+      REAL dtvr,daysec
+      REAL pi,dtphys,dtdiss,rad,r,cpp,kappa
+      REAL cotot,unsim,g,omeg
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdiss.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdiss.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdiss.h	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comdiss.h'
+
+      INTEGER niter
+      REAL tetau(llm),tetah(llm),cdivu,cdivh,crot
+      LOGICAL dissipst
+
+      COMMON/comdissi/niter
+      COMMON/comdissr/tetau,tetah,cdivu,cdivh,crot
+      COMMON/comdissl/dissipst
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissip.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissip.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissip.h	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE dissip.h
+
+      COMMON/comdissip/
+     $    niterdis,coefdis,tetavel,tetatemp,gamdissip
+
+
+      INTEGER niterdis
+
+      REAL tetavel,tetatemp,coefdis,gamdissip
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissipn.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissipn.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissipn.h	(revision 46)
@@ -0,0 +1,13 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissipn.h
+
+      REAL  tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
+c
+      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,
+     1                        cdivu,      crot,         cdivh
+
+c
+c    Les parametres de ce common proviennent des calculs effectues dans 
+c             Inidissip  .
+c
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissnew.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissnew.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comdissnew.h	(revision 46)
@@ -0,0 +1,15 @@
+c-----------------------------------------------------------------------
+c INCLUDE comdissnew.h
+
+      COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,
+     1                   tetagrot,tetatemp,coefdis 
+
+      LOGICAL lstardis
+      INTEGER nitergdiv, nitergrot, niterh
+      REAL     tetagdiv, tetagrot,  tetatemp, coefdis
+
+c
+c ... Les parametres de ce common comdissnew sont  lues par defrun_new 
+c              sur le fichier  run.def    ....
+c
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom.h	(revision 46)
@@ -0,0 +1,36 @@
+!
+! Warning, these commons are also defined in comgeom2.h, so be careful
+! about possible mismatches if you modify either file.
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+!CDK comgeom
+      COMMON/comgeom/                                                   &
+     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
+     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
+     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
+     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
+     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
+     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
+     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
+     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
+     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
+     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
+     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
+     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
+     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
+     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
+     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
+     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+
+!
+        REAL                                                            &
+     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
+     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
+     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
+     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
+     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
+     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
+     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
+     & , xprimv
+!
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom2.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom2.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comgeom2.h	(revision 46)
@@ -0,0 +1,37 @@
+!
+! Warning, these commons are also defined in comgeom.h, so be careful
+! about possible mismatches if you modify either file.
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+!CDK comgeom2
+      COMMON/comgeom/                                                   &
+     & cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  , &
+     & aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           , &
+     & airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 , &
+     & unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       , &
+     & aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       , &
+     & aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         , &
+     & alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        , &
+     & alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    , &
+     & fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),      &
+     & rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  , &
+     & cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        , &
+     & cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1), &
+     & cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) , &
+     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                , &
+     & unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  , &
+     & unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)  &
+     & , xprimu(iip1),xprimv(iip1)
+
+!
+      REAL                                                              &
+     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire&
+     & ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     ,&
+     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
+     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
+     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           ,&
+     & unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     ,&
+     & unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    ,&
+     & cusurcvu,xprimu,xprimv
+!
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comvert.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comvert.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/comvert.h	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'comvert.h'
+
+      COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
+     .               pa,preff,nivsigs(llm),nivsig(llm+1),
+     .               sig(llm+1),ds(llm),aps(llm),bps(llm),pseudoalt(llm)
+
+      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+c Mars Ce qui suit vient de gcm
+      REAL sig,ds,aps,bps,pseudoalt
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/control.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/control.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/control.h	(revision 46)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+! INCLUDE 'control.h'
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+! newWRF: OK
+
+      COMMON/control/nday,day_step,                                     &
+     &              iperiod,iconser,idissip,iphysiq ,                   &
+     &              periodav,ecritphy,anneeref
+
+      INTEGER   nday,day_step,iperiod,iconser,                          &
+     &          idissip,iphysiq,anneeref
+      REAL periodav, ecritphy
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/description.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/description.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/description.h	(revision 46)
@@ -0,0 +1,2 @@
+      character *120 descript
+      common /titre/descript
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/diff.log.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/diff.log.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/diff.log.h	(revision 46)
@@ -0,0 +1,171 @@
+4,5c4,8
+<       COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,
+<      1                   tetagrot,tetatemp,coefdis 
+---
+> 
+> c****WRF: attention ligne trop longue
+> 
+>       COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,
+>      1                   tetagdiv,tetagrot,tetatemp,coefdis 
+1,25c1,19
+< !
+< ! Warning, these commons are also defined in comgeom.h, so be careful
+< ! about possible mismatches if you modify either file.
+< ! For Fortran 77/Fortran 90 compliance always use line continuation
+< ! symbols '&' in columns 73 and 6
+< !
+< !CDK comgeom2
+<       COMMON/comgeom/                                                   &
+<      & cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  , &
+<      & aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           , &
+<      & airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 , &
+<      & unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       , &
+<      & aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       , &
+<      & aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         , &
+<      & alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        , &
+<      & alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    , &
+<      & fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),      &
+<      & rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  , &
+<      & cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        , &
+<      & cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1), &
+<      & cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) , &
+<      & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                , &
+<      & unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  , &
+<      & unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)  &
+<      & , xprimu(iip1),xprimv(iip1)
+---
+> *CDK comgeom2
+>       COMMON/comgeom/
+>      1 cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  ,
+>      2 aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           ,
+>      3 airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 ,  
+>      4 unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       ,
+>      5 aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       ,
+>      6 aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         ,
+>      7 alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        ,
+>      8 alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    ,
+>      9 fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),
+>      1 rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  ,
+>      1 cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        ,
+>      2 cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1),
+>      3 cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) ,
+>      4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                ,
+>      5 unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  ,
+>      6 unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)
+>      7 , xprimu(iip1),xprimv(iip1)
+27,37c21,31
+< !
+<       REAL                                                              &
+<      & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire&
+<      & ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     ,&
+<      & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
+<      & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
+<      & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           ,&
+<      & unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     ,&
+<      & unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    ,&
+<      & cusurcvu,xprimu,xprimv
+< !
+---
+> c
+>       REAL 
+>      1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire
+>      2 ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     ,
+>      3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+>      4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+>      5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           , 
+>      6 unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     ,
+>      7 unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    ,
+>      8 cusurcvu,xprimu,xprimv
+> c
+1,6d0
+< !
+< ! Warning, these commons are also defined in comgeom2.h, so be careful
+< ! about possible mismatches if you modify either file.
+< ! For Fortran 77/Fortran 90 compliance always use line continuation
+< ! symbols '&' in columns 73 and 6
+< !
+8,24c2,28
+<       COMMON/comgeom/                                                   &
+<      & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
+<      & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
+<      & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
+<      & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
+<      & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
+<      & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
+<      & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
+<      & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
+<      & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
+<      & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
+<      & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
+<      & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
+<      & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
+<      & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
+<      & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
+<      & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+---
+>       COMMON/comgeom/
+>      .cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
+>      .aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
+>      .airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
+>      .unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
+>      .aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
+>      .aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
+>      .alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
+>      .alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
+>      .fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
+>      .rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
+>      .cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
+>      .cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
+>      .cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
+>      .unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
+>      .unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
+>      .aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+> 
+>       REAL :: 
+>      .cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
+>      .apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
+>      .alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
+>      .fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
+>      .cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2,
+>      .unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
+>      .aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu,
+>      .xprimv
+26,36d29
+< !
+<         REAL                                                            &
+<      & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
+<      & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
+<      & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
+<      & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
+<      & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
+<      & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
+<      & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
+<      & , xprimv
+< !
+1,5c1,2
+< !-----------------------------------------------------------------------
+< ! INCLUDE 'control.h'
+< ! For Fortran 77/Fortran 90 compliance always use line continuation
+< ! symbols '&' in columns 73 and 6
+< ! newWRF: OK
+---
+> c-----------------------------------------------------------------------
+> c INCLUDE 'control.h'
+7,9c4,6
+<       COMMON/control/nday,day_step,                                     &
+<      &              iperiod,iconser,idissip,iphysiq ,                   &
+<      &              periodav,ecritphy,anneeref
+---
+>       COMMON/control/nday,day_step,
+>      $              iperiod,iconser,idissip,iphysiq ,
+>      $              periodav,ecritphy,anneeref
+11,12c8,9
+<       INTEGER   nday,day_step,iperiod,iconser,                          &
+<      &          idissip,iphysiq,anneeref
+---
+>       INTEGER   nday,day_step,iperiod,iconser,
+>      $          idissip,iphysiq,anneeref
+15c12
+< !-----------------------------------------------------------------------
+---
+> c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/disvert.orig
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/disvert.orig	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/disvert.orig	(revision 46)
@@ -0,0 +1,341 @@
+      SUBROUTINE disvert 
+
+c    Auteur :  P. Le Van . F. Forget Y. Wanherdrick
+c    Many modif special mars !!
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "hybrid.h"
+c
+c=======================================================================
+c    Discretisation verticale en coordonnée hybride
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+c
+      INTEGER l,ll
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h,zsig,quoi,quand
+      INTEGER np,ierr
+      integer :: ierr1,ierr2,ierr3,ierr4
+      REAL x
+
+      REAL SSUM
+      EXTERNAL SSUM
+      real newsig 
+      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
+      real tt,rr,gg, prevz
+      real s(llm),dsig(llm) 
+
+c
+c-----------------------------------------------------------------------
+c
+      pi=2.*ASIN(1.)
+
+      open(99,file="sigma.def",status='old',form='formatted',
+     s   iostat=ierr1)
+! Ouverture possible de fichiers typiquement E.T.
+
+      if(ierr1.ne.0) then
+         close(99)
+         open(99,file="esasig.def",status='old',form='formatted',
+     s   iostat=ierr2)
+         if(ierr2.ne.0) then
+            close(99)
+            open(99,file="tritonsig.def",status='old',form='formatted',
+     s      iostat=ierr3)
+            if(ierr3.ne.0) then
+              close(99)
+              open(99,file="z2sig.def",status='old',form='formatted',
+     s        iostat=ierr4)
+            endif
+         endif
+      endif
+
+c-----------------------------------------------------------------------
+c   cas 1 on lit les options dans sigma.def:
+c   ----------------------------------------
+
+      IF (ierr1.eq.0) THEN
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de sigma.def'
+         PRINT*,'*****************************'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+c
+
+       DO l = 1, llm
+          dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*
+     $          ( (tanh(gama*l)/tanh(gama*llm))**np +
+     $            (1.-l/FLOAT(llm))*delta )
+       ENDDO
+
+       sig(1)=1.
+       DO l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+       ENDDO
+       sig(llm+1)=0.
+
+c
+
+! Debut de la partie martienne pour lecture de esasig.def
+c=========================================================
+
+      ELSE IF(ierr2.eq.0) then
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de esasig.def'
+         PRINT*,'*****************************'
+         READ(99,*) h
+         READ(99,*) dz0
+         READ(99,*) dz1
+         READ(99,*) nhaut
+         CLOSE(99)
+
+         dz0=dz0/h
+         dz1=dz1/h
+
+         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
+
+         esig=1.
+
+         PRINT*
+         do l=1,20
+            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
+         enddo
+         print*,'esig=',esig
+         PRINT*
+         csig=(1./sig1-1.)/(exp(esig)-1.)
+
+         DO L = 2, llm
+            zz=csig*(exp(esig*(l-1.))-1.)
+            sig(l) =1./(1.+zz)
+     &      * tanh(.5*(llm+1-l)/nhaut)
+         ENDDO
+         sig(1)=1.
+         sig(llm+1)=0.
+
+c Fin de la partie martienne
+c ==========================
+
+      ELSE IF(ierr3.eq.0) then
+
+         PRINT*,'********************************'
+         PRINT*,'WARNING Lecture de tritonsig.def'
+         PRINT*,'********************************'
+         PRINT*,'kappa=', kappa
+         READ(99,*) gg
+         READ(99,*) rr
+         sig(1)=1.
+         prevz=0.
+         do l=1,llm-1
+           read(99,*) zz, tt
+           sig(l+1) = sig(l)* exp(-(zz-prevz)*gg/(rr*tt))
+           prevz=zz
+           if(l.eq.llm/2)h =1.e-3* rr*tt/gg
+         end do
+         sig(llm+1)=0.
+         CLOSE(99)
+
+      ELSE IF(ierr4.eq.0) then
+         PRINT*,'****************************'
+         PRINT*,'WARNING Lecture de z2sig.def'
+         PRINT*,'****************************'
+
+
+         READ(99,*) h
+         do l=1,llm
+            read(99,*) zsig
+            s(l) = exp(-kappa*zsig/h)
+         end do
+         CLOSE(99)
+
+         sig(1) =1
+         do l=2,llm
+           sig(l) = 0.5 * (s(l)**(1/kappa)+s(l-1)**(1/kappa))
+         end do
+         sig(llm+1) =0
+
+      ELSE
+c-----------------------------------------------------------------------
+c   cas 2 ancienne discretisation (LMD5...):
+c   ----------------------------------------
+
+      PRINT*,'********************************************'
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+      PRINT*,'********************************************'
+      stop ! interdit sur MARS
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+
+      ENDIF
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+
+c    On ne recalcule s que dans les cas "classique"
+c    (esasig.def, sigma.def, ou ancienne discretisation sans fichier)
+      IF( (ierr1.eq.0) .or. (ierr2.eq.0)
+     &   .or. ((ierr3.ne.0).and.(ierr4.ne.0)) ) then
+         quoi      = 1. + 2.* kappa
+         s( llm )  = 1.
+         s(llm-1) = quoi
+         IF( llm.gt.2 )  THEN
+            DO  ll = 2, llm-1
+               l         = llm+1 - ll
+               quand     = sig(l+1)/ sig(l)
+               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
+            ENDDO
+         END IF
+c
+         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
+         DO l = 1, llm
+            s(l)    = s(l)/ snorm
+         ENDDO
+      END IF
+
+c
+c    ....  Calculs  de ap(l) et de bp(l)  ....
+c    .........................................
+c
+c
+c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
+c
+
+
+      if (hybrid) then
+         write(*,*) "*******************************"
+         write(*,*) "Systeme en coordonnees hybrides"
+         write(*,*) 
+c        Coordonnees hybrides avec mod
+         write(*,*) "sig disvert",sig
+         DO l = 1, llm
+            call sig_hybrid(sig(l),pa,preff,1.e-6,newsig)
+            bp(l) = EXP( 1. -1./( newsig*newsig) )
+            ap(l) = pa * (newsig - bp(l) )
+         enddo
+         call sig_hybrid(sig(llmp1),pa,preff,1.e-6,newsig)
+         ap(llmp1) = pa * ( newsig - bp(llmp1) )
+      else
+         write(*,*) "****************************"
+         write(*,*) "Systeme en coordonnees sigma"
+         write(*,*) 
+c        Pour ne pas passer en coordonnees hybrides
+         DO l = 1, llm
+            ap(l) = 0.
+            bp(l) = sig(l)
+         ENDDO
+         ap(llmp1) = 0.
+      endif
+
+      bp(llmp1) =   0.
+
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+
+c     Calcul au milieu des couches :
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     Le calcul du niveau pour la derniere couche 
+c     (on met la meme distance (en log pression)  entre P(llm)
+c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
+c     Specifique.  Ce choix est spécifié ici ET dans exner_hyb.F
+
+      DO l = 1, llm-1
+       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
+       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
+      ENDDO
+     
+      if (hybrid) then
+         aps(llm) = ap(llm-1)**2 / ap(llm-2) 
+         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
+      else
+         bps(llm) = bp(llm-1)**2 / bp(llm-2) 
+         aps(llm) = 0.
+      end if
+
+      PRINT *,' BPs '
+      PRINT *,  bps
+      PRINT *,' APs'
+      PRINT *,  aps
+
+      DO l = 1, llm
+       presnivs(l) = aps(l)+bps(l)*preff
+       pseudoalt(l) = -10.*log(presnivs(l)/preff)
+      ENDDO
+
+      PRINT *,' PRESNIVS' 
+      PRINT *,presnivs 
+      PRINT *,'Pseudo altitude des Presnivs : ' 
+      PRINT *,pseudoalt
+
+      RETURN
+      END
+
+c ************************************************************
+      subroutine sig_hybrid(sig,pa,preff,xacc,newsig)
+c     ----------------------------------------------
+c     Subroutine utilisee pour calculer des valeurs de sigma modifie
+c     pour conserver les coordonnees verticales decrites dans
+c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
+c     F. Forget 2002
+c     ----------------------------------------------
+      implicit none
+      real x1, x2, xacc, sig,pa,preff, newsig, F
+      integer j
+
+      newsig = sig
+      x1=0
+      x2=1
+      if ((sig.ne.0).and.(sig.ne.1)) then
+        DO J=1,9999  ! nombre d''iteration max
+          F=(1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig -sig
+          if (F.gt.0) then
+              X2 = newsig
+              newsig=(X1+newsig)*0.5
+          else
+              X1 = newsig
+              newsig=(X2+newsig)*0.5
+          end if
+c       write(0,*) J, ' newsig =', newsig, ' F= ', F
+
+        IF(X2-X1.LT.XACC) RETURN
+        END DO
+       end if
+       Return
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ener.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ener.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ener.h	(revision 46)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'ener.h'
+
+      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,
+     *            ang,etot,ptot,ztot,stot,rmsdpdt ,
+     *            rmsv,gtot(llmm1)
+
+      REAL ang0,etot0,ptot0,ztot0,stot0,
+     s     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/exnerF
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/exnerF	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/exnerF	(revision 46)
@@ -0,0 +1,88 @@
+      SUBROUTINE  exner ( ngrid, ps, p, pks, pk, pkf )
+c
+c     Auteurs :  P.Le Van  , Fr. Hourdin  .
+c    ..........
+c
+c    .... ngrid, ps,p  sont des argum.d'entree  au sous-prog.   ....
+c    .... pks,pk,pkf   sont des argum.de sortie au sous-prog.   ....
+c
+c   ************************************************************************
+c    Calcule la fonction d'Exner pk = Cp * p ** kappa , aux milieux des 
+c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+c   ************************************************************************
+c  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+c    la pression et la fonction d'Exner  au  sol  .
+c
+c                                 -------- z                                   
+c    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
+c                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
+c    ( voir note de Fr.Hourdin )  ,
+c
+c    on determine successivement , du haut vers le bas des couches, les 
+c    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2), 
+c    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches,  
+c     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+
+      INTEGER  ngrid
+      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
+      REAL ps(ngrid),pks(ngrid)
+      INTEGER l, ij
+      REAL alpha(ngrid,llm),beta(ngrid,llm),unpl2k,delta
+      EXTERNAL filtreg
+c
+      unpl2k    = 1.+ 2.* kappa
+c
+      DO   ij  = 1, ngrid
+       pks(ij) = cpp * (ps(ij)/preff) ** kappa
+      ENDDO
+c
+c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
+c
+      DO     ij      = 1, ngrid
+       alpha(ij,llm) = 0.
+       beta (ij,llm) = 1./ unpl2k
+      ENDDO
+c
+c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
+c
+      DO l = llm -1 , 2 , -1
+c
+        DO ij = 1, ngrid
+        delta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
+        alpha(ij,l)  = - p(ij,l+1) / delta * alpha(ij,l+1)
+        beta (ij,l)  =   p(ij,l  ) / delta   
+        ENDDO
+c
+      ENDDO
+c
+c  ***********************************************************************
+c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
+c
+      DO   ij   = 1, ngrid
+       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
+     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
+      ENDDO
+c
+c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
+c
+      DO l = 2, llm
+        DO   ij   = 1, ngrid
+         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
+        ENDDO
+      ENDDO
+c
+c
+      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+      CALL filtreg ( pkf, jmp1, llm, 2, 1, .true., 1)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/gradsdef.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/gradsdef.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/gradsdef.h	(revision 46)
@@ -0,0 +1,20 @@
+      integer nfmx,imx,jmx,lmx,nf,nvarmx
+      parameter(nfmx=10,imx=200,jmx=150,lmx=20,nvarmx=1000)
+
+      real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
+
+      integer imd(imx),jmd(jmx),lmd(lmx)
+      integer iid(imx),jid(jmx)
+      integer ifd(imx),jfd(jmx)
+      integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
+
+      integer nvar(nfmx),ivar(nfmx)
+      logical firsttime(nfmx)
+
+      character*10 var(nvarmx,nfmx),fichier(nfmx)
+      character*40 title(nfmx),tvar(nvarmx,nfmx)
+
+      common/gradsdef/xd,yd,zd,dtime,
+     s   imd,jmd,lmd,iid,jid,ifd,jfd,
+     s   unit,irec,nvar,ivar,nf,itime,nld,firsttime,
+     s   var,fichier,title,tvar
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/logic.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/logic.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/logic.h	(revision 46)
@@ -0,0 +1,10 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'logic.h'
+
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
+     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
+     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/para_netcdf.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/para_netcdf.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/para_netcdf.h	(revision 46)
@@ -0,0 +1,10 @@
+c
+      INTEGER lons ,lats,levs
+      PARAMETER (lons = 320, lats = 161, levs = 17)
+c
+c     *******    a  changer  eventuellement   ********`
+c
+c  *** Ces valeurs de lons et de lats correspondent a une grille 1.125 x1.125
+c                  du fichier d'entree en Netcdf     ******
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/paramet.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/paramet.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/paramet.h	(revision 46)
@@ -0,0 +1,19 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'paramet.h'
+
+      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
+      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
+      INTEGER  ijmllm,mvar
+      INTEGER jcfil,jcfllm
+
+      PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3)
+      PARAMETER( jjp1=jjm+1-1/jjm)
+      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
+      PARAMETER( kftd  = iim/2 -ndm )
+      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
+      PARAMETER( ip1jmi1= ip1jm - iip1 )
+      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
+      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
+      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ps_amontF
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ps_amontF	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/ps_amontF	(revision 46)
@@ -0,0 +1,454 @@
+      SUBROUTINE ps_amont(nq,iq,q,w,pbaru,pbarv,dq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      INTEGER nq,iq
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL pente(ip1jmp1),xg(ip1jmp1),xd(ip1jmp1),xs(ip1jmp1) ,
+     *     xn(ip1jmp1),xb(ip1jmp1),xh(ip1jmp1)
+      REAL qg(ip1jmp1),qd(ip1jmp1),qs(ip1jmp1) ,
+     *     qn(ip1jmp1),qb(ip1jmp1,llm),qh(ip1jmp1,llm)
+      REAL qbyv(ip1jm,llm), qbxu(ip1jmp1,llm), ww,dqh(ip1jmp1,llm)
+      REAL qpns,qpsn
+      logical first,extrpn,extrps
+      save first
+c
+c
+      REAL      SSUM,CVMGP,CVMGT
+      EXTERNAL  SSUM, convflu
+
+      data first/.true./
+
+      if(first) then
+         print*,'SCHEMA AMONT NOUVEAU'
+         first=.false.
+      endif
+
+
+c
+c
+      IF( forward.OR.leapf )   THEN
+c
+c
+      DO  100  l = 1, llm
+c
+c   ...  Boucle sur les  llm niveaux verticaux ...
+c
+c
+c  --------------------------------------------------------------
+c  --------------------------------------------------------------
+c  .............      Traitement en longitude     ...............
+c  --------------------------------------------------------------
+c  --------------------------------------------------------------
+c
+c     
+c        |          |            |           |
+c        |   q(i-1) |     q(i)   |   q(i+1)  |
+c        |          |qg(i)  qd(i)|qg(i+1)    |
+c
+c
+c      En  longitude ,
+c      Pour chaque maille ( i ) avec q(i,j,l,iq), on cherche a determiner
+c      avec une methode de ' pente' les valeurs qg(i) et qd(i) qui se trouvent
+c      au bord gauche et droite de cette maille .
+c
+c      Si ( q(i+1)-q(i) ) * ( q(i)-q(i-1)) < 0. ,on a qg(i)=qd(i)=q(i)
+c              Sinon
+c      qg(i)= q(i) - 1/4 * ( q(i+1) - q(i-1))
+c      qd(i)= q(i) + 1/4 * ( q(i+1) - q(i-1) )
+c
+c      On utilisera la meme methode pour determiner les valeurs qs(i) et qn(i)
+c      en latitude , ainsi que les valeurs qb(i) et qh(i) en  altitude .
+c
+c
+c
+       DO      ij    = 1,iip1
+       qg(ij)        = 0.
+       qd(ij)        = 0.
+       qg(ij+ ip1jm) = 0.
+       qd(ij+ ip1jm) = 0.
+       ENDDO
+c
+c     ....  calculs pour les lignes j= 2 a j = jjm  ....
+c
+       DO   ij    = iip2, ip1jm -1
+       pente(ij)  =( q(ij+1,l,iq)-q(ij,l,iq)) *(q(ij,l,iq)-q(ij-1,l,iq)) 
+       xg(ij)     = q(ij,l,iq) - 0.25 * ( q(ij+1,l,iq) - q(ij-1,l,iq) )
+       xd(ij)     = q(ij,l,iq) + 0.25 * ( q(ij+1,l,iq) - q(ij-1,l,iq) )
+       qg(ij)     = CVMGP( xg(ij), q(ij,l,iq) ,pente(ij) )
+       qd(ij)     = CVMGP( xd(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+
+c    ... Correction aux points  ( i= 1,  j )  .....
+c
+       DO   ij   = iip2, ip1jm, iip1
+       pente(ij) = ( q(ij+1,l,iq) - q(ij,l,iq) )     * 
+     *                                ( q(ij,l,iq)  - q(ij+iim-1,l,iq) )
+       xg(ij)    = q(ij,l,iq) - 0.25* ( q(ij+1,l,iq)- q(ij+iim-1,l,iq) )
+       xd(ij)    = q(ij,l,iq) + 0.25* ( q(ij+1,l,iq)- q(ij+iim-1,l,iq) )
+       qg(ij)    = CVMGP( xg(ij), q(ij,l,iq) ,pente(ij) )
+       qd(ij)    = CVMGP( xd(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c    ... Correction aux points ( i= iip1,  j ) .....
+c
+       DO     ij      = iip2, ip1jm, iip1
+       qg( ij+ iim  ) = qg( ij )
+       qd( ij+ iim )  = qd( ij )
+       ENDDO
+c
+c   .............................................................
+c   .........    Limitation des pentes a gauche des boites  .....
+c
+c    Si (q(i)-qg(i))*(qg(i)-q(i-1)) < 0.  , on a  qg(i)=q(i-1)  
+c                                         et qd(i)=2*q(i)-qg(i)
+c   .............................................................
+c
+       DO   ij  = iip2,ip1jm -1
+       pente(ij)= ( qg(ij) -q(ij-1,l,iq))*(q(ij,l,iq)-qg(ij) )
+       qg(ij)   = CVMGP( qg(ij), q(ij-1,l,iq) ,pente(ij) )
+       qd(ij)   = CVMGP( qd(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qg(ij) , pente(ij) ) 
+       ENDDO
+c
+c      .....   Correction aux points ( i= 1,  j )  ......
+c
+       DO    ij  = iip2 ,ip1jm, iip1
+       qg(ij)    =  qg(ij+ iim)
+       qd(ij)    =  qd(ij+ iim)
+       ENDDO
+c    
+c      ...............................................................
+c      ...... Limitation des pentes a droite des boites      .........
+c      Si (q(i+1)-qd(i))*(qd(i)-q(i)) < 0. , on a qd(i)=q(i+1)
+c                                              et qg(i)=2*q(i)-qd(i) .
+c      ...............................................................
+c
+       DO ij = iip2, ip1jm -1
+       pente(ij) = ( qd(ij)-q(ij,l,iq) )*(q(ij+1,l,iq)-qd(ij) ) 
+       qd(ij)    =  CVMGP( qd(ij), q(ij+1,l,iq), pente(ij) )
+       qg(ij)    =  CVMGP( qg(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qd(ij) , pente(ij) ) 
+       ENDDO
+c
+c      ....  Correction aux points ( i = iip1, j )  .....
+c
+       DO     ij     = iip2, ip1jm, iip1
+       qg( ij+ iim ) = qg( ij )
+       qd( ij+ iim ) = qd( ij )
+       ENDDO
+c
+
+c     -------------------------------------------------------------
+c     -------------------------------------------------------------
+c     .............    Traitement en  latitude    .................
+c     -------------------------------------------------------------
+c     -------------------------------------------------------------
+c
+c
+c      q(j=1)   PN
+c   --------------
+c     ---------  
+c   --------------
+c
+c      q(j-1)
+c
+c   --------------
+c            qn(j)
+c      q(j)
+c            qs(j)
+c   --------------
+c        
+c      q(j+1)
+c
+c   --------------
+c
+c      q(jjp1)  PS
+c
+c   --------------
+c
+c
+c     ......   operations pour les lignes j= 2 a j= jjm  .......
+c
+       DO    ij    = iip2, ip1jm
+       pente(ij)   = ( q(ij-iip1,l,iq)- q(ij,l,iq)  )  *
+     *               ( q(ij,l,iq) - q(ij+iip1,l,iq) )
+       xs(ij) = q(ij,l,iq) - 0.25 * ( q(ij-iip1,l,iq) -q(ij+iip1,l,iq) )
+       xn(ij) = q(ij,l,iq) + 0.25 * ( q(ij-iip1,l,iq) -q(ij+iip1,l,iq) )
+       qs(ij) = CVMGP( xs(ij), q(ij,l,iq), pente(ij) )
+       qn(ij) = CVMGP( xn(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c
+c     ......    Calculs aux  poles   .............................
+c     ............................................................
+c
+c     On n'a pas besoin des valeurs de  qn au pole Nord ( j=    1) ,
+c      ainsi que de celles de           qs au pole Sud  ( j= jjp1)
+c
+c
+      airej2 = SSUM( iim, aire(iip2), 1 )
+      airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+c
+c     qpns , val.moyenne de q sur la ligne j= 2
+c     qpsn , val.moyenne de q sur la ligne j= jjm
+c
+c
+c
+c  on cherche si on a un extremum au pole
+c
+      extrpn=.true.
+      extrps=.true.
+      DO ij=2,iim
+         if((q(iip1+i,l,iq)-q(1,l,iq))*(q(iip2,l,iq)-q(1,l,iq)).lt.0.)
+     .   extrpn=.false.
+         if((q(ip1jm-iip1+i,l,iq)-q(1,l,iq))*
+     .     (q(ip1jm-iim,l,iq)-q(1,l,iq)).lt.0.)
+     .      extrps=.false.
+      ENDDO
+
+c   calcul des pentes au pole
+
+      if(extrpn) then
+         DO    ij     = 1, iip1
+            qs(ij)= q(ij,l,iq)
+         ENDDO
+      else
+         DO    ij     = 1, iip1
+            qs(ij)= q(ij,l,iq) + 0.5 * ( q(ij+ iip1,l,iq) - qpns )
+         ENDDO
+      endif
+
+      if(extrps) then
+         DO    ij     = 1, iip1
+            qn(ij+ip1jm) = q(ij+ip1jm,l,iq)
+         ENDDO
+      else
+         DO    ij     = 1, iip1
+            qn(ij+ip1jm) = q(ij+ip1jm,l,iq) +   0.5 *
+     *                    ( q(ij+ip1jm-iip1,l,iq) - qpsn )
+         ENDDO
+      endif
+
+c
+c
+c    .........................................................
+c    ......    Limitation des pentes au sud des boites   .....
+c    .........................................................    
+c
+      DO   ij     = 1, ip1jm
+      pente(ij)   = ( qs(ij) - q (ij+iip1,l,iq) )   *
+     *              ( q( ij,l,iq) - qs( ij ) )
+      qs(ij) = CVMGP( qs(ij) , q(ij+iip1,l,iq), pente(ij) )
+      qn(ij) = CVMGP( qn(ij) , 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qs(ij), pente(ij) )
+      ENDDO
+c
+c
+c     .......................................................
+c     .... Limitation des pentes au nord des boites .........
+c     .......................................................
+c
+      DO   ij     = iip2, ip1jmp1
+      pente(ij)   = ( qn( ij  ) -  q(ij,l,iq) )  *
+     *              (  q(ij-iip1,l,iq) - qn(ij) )
+      qn(ij)      = CVMGP( qn(ij), q(ij-iip1,l,iq), pente(ij) )
+      qs(ij)      = CVMGP( qs(ij), 
+     *                q(ij,l,iq)+ q(ij,l,iq) -qn(ij) , pente(ij) )
+      ENDDO
+c
+c
+c    .............................................................
+c    .....   Calculs des flux de  q  sur le plan horizontal ......
+c    .............................................................
+c
+c
+c
+c      
+c      ....  Selon   X  .... 
+c
+         DO  ij     = iip2, ip1jm - 1
+c
+         qbxu( ij,l ) =  pbaru( ij,l )   *
+     *            CVMGT( qd(ij), qg(ij +1), pbaru(ij,l).GT.0. )
+         ENDDO
+c
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+c
+c           &&&CDIR$ IVDEP
+         DO    ij     = iip1 +iip1, ip1jm, iip1
+         qbxu( ij,l ) = qbxu( ij - iim, l )
+         ENDDO
+c
+c      .... Selon Y  .....
+c
+         DO    ij     = 1, ip1jm
+         qbyv( ij,l ) =  pbarv( ij,l )    *
+     *             CVMGT( qn(ij+iip1), qs(ij), pbarv(ij,l).GT.0. )
+         ENDDO
+c
+c
+c
+  100  CONTINUE
+c
+c     ..........................................................
+c     ( ... fin des traitements en longitude et latitude  ... )
+c
+c
+c   stockage dans  dqh  de la convergence horiz.du flux d'humidite  .
+c                   ....
+c
+c
+                 CALL convflu( qbxu, qbyv, llm, dqh )
+c
+c
+c
+c    ----------------------------------------------------------------
+c    ----------------------------------------------------------------
+c    .............      Traitement  en  altitude        .............
+c    ----------------------------------------------------------------
+c    ----------------------------------------------------------------
+c
+c
+c     -------------
+c        q (llm)
+c
+c     -------------
+c     -------------
+c
+c        q(l+1)
+c
+c     -------------
+c             qh(l)
+c        q(l)
+c             qb(l)
+c     -------------
+c
+c        q(l-1)
+c
+c     -------------
+c     -------------
+c        q(1)
+c     -------------
+c
+c
+c    ... Calculs pour les niveaux 2 a llm -1  ...
+c
+c
+      DO  200   l = 2, llm -1
+
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( q(ij, l+1 ,iq)  - q(ij , l  ,   iq) )  * 
+     *               ( q(ij,   l ,iq)  - q(ij ,l-1 ,   iq) )
+       xb(ij)      = q(ij,l,iq) - 0.25* ( q(ij,l+1,iq) - q(ij,l-1,iq) )
+       xh(ij)      = q(ij,l,iq) + 0.25* ( q(ij,l+1,iq) - q(ij,l-1,iq) )
+       qb(ij,l)    = CVMGP( xb(ij), q(ij,l,iq), pente(ij) )
+       qh(ij,l)    = CVMGP( xh(ij), q(ij,l,iq), pente(ij) )
+       ENDDO
+c
+c     ........................................................
+c     ......  Limitation des pentes en bas des boites   ......
+c     ........................................................
+c
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( qb(ij,l) - q ( ij,l-1,iq) )   *
+     *                ( q (ij,l,iq) - qb( ij,l ) )
+       qb(ij,l)    = CVMGP( qb(ij,l), q(ij,l-1,iq), pente(ij) )
+       qh(ij,l)    = CVMGP( qh(ij,l), 
+     *               q(ij,l,iq) + q(ij,l,iq) -qb(ij,l), pente(ij) )
+       ENDDO
+c
+c
+c     ........................................................
+c     ......  Limitation des pentes en haut des boites   ......
+c     ........................................................
+c
+       DO   ij     = 1, ip1jmp1
+       pente(ij)   = ( qh(ij,l) - q ( ij,l+1,iq) )   *
+     *                ( q (ij,l,iq) - qh( ij,l ) )
+       qh(ij,l)    = CVMGP( qh(ij,l), q(ij,l+1,iq), pente(ij) )
+       qb(ij,l)    = CVMGP( qb(ij,l), 
+     *               q(ij,l,iq) + q(ij,l,iq) -qh(ij,l), pente(ij) )
+       ENDDO
+c
+c
+  200  CONTINUE
+c
+c
+c    ............................................................
+c    .....     Calculs pour les niveaux l= 1 et l= llm  .........
+c    ............................................................
+c
+      DO   ij    = 1, ip1jmp1
+      qb(ij,1)   = q(ij, 1 , iq)
+      qb(ij,llm) = q(ij,llm, iq)
+      qh(ij,1)   = q(ij, 1 , iq)
+      qh(ij,llm) = q(ij,llm, iq)
+      ENDDO
+c
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 300 l = 1,llmm1
+c
+         DO  ij = 1,ip1jmp1
+          ww= - w( ij,l+1 ) * 
+     *        CVMGT ( qh(ij,l), qb(ij,l+1), w(ij,l+1).LT.0.)
+
+          dq (ij, l ,iq ) = dqh(ij, l )   - dsig1( l ) * ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   + dsig1(l+1) * ww
+         ENDDO
+c
+  300   CONTINUE 
+c
+c
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+c
+c
+      END IF
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/serre.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/serre.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/serre.h	(revision 46)
@@ -0,0 +1,6 @@
+c..include serre.h
+c
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/sponge.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/sponge.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/sponge.h	(revision 46)
@@ -0,0 +1,9 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'sponge.h'
+
+      COMMON/com_sponge/callsponge,mode_sponge,hsponge,tetasponge
+
+      LOGICAL   callsponge
+      INTEGER   mode_sponge
+      REAL   hsponge,tetasponge
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/temps.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/temps.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/temps.h	(revision 46)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'temps.h'
+
+      COMMON/temps/itaufin,dt,
+     s  day_ini,day_end,anne_ini
+
+      INTEGER  itaufin
+      INTEGER*4 day_ini,day_end,anne_ini
+      REAL     dt
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/tracstoke.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/tracstoke.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/dyn3d/tracstoke.h	(revision 46)
@@ -0,0 +1,2 @@
+      common /tracstoke/istdyn,istphy,unittrac
+      integer istdyn,istphy,unittrac
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate2	(revision 46)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate2 {} \;
+# change number sed -e s/d2/d3/g generate2 > generate3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d2_'/g ${1} | sed -e s/'call d2_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d2_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d2_'/'firstcall '/g | sed -e s/'lastcall d2_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d2_'/g | sed -e s/'callphys.def'/'callphysd2_.def '/g | sed -e s/'diagfi.nc'/'diagfid2_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d2_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd2_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d2_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d2_"+g | sed -e s+"d2_netcdf.inc"+"netcdf.inc"+g > d2_${1} 
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate3
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate3	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate3	(revision 46)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate_d3 {} \;
+# change number sed -e s/d3/d3/g generate_d3 > generated3
+
+sed -e s/'[cC][aA][lL][lL] '/'call d3_'/g ${1} | sed -e s/'call d3_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d3_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d3_'/'firstcall '/g | sed -e s/'lastcall d3_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d3_'/g | sed -e s/'callphys.def'/'callphysd3_.def '/g | sed -e s/'diagfi.nc'/'diagfid3_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d3_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd3_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d3_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d3_"+g | sed -e s+"d3_netcdf.inc"+"netcdf.inc"+g > d3_${1} 
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate4
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate4	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/generate4	(revision 46)
@@ -0,0 +1,7 @@
+#script
+# execute: find * -exec generate_d4 {} \;
+# change number sed -e s/d4/d4/g generate_d4 > generated4
+
+sed -e s/'[cC][aA][lL][lL] '/'call d4_'/g ${1} | sed -e s/'call d4_[aA][bB][oO][rR][tT]'/'call ABORT'/g | sed -e s/'call d4_[eE][xX][iI][tT]'/'call EXIT'/g | sed -e s/'firstcall d4_'/'firstcall '/g | sed -e s/'lastcall d4_'/'lastcall '/g | sed -e s/'[sS][uU][bB][rR][oO][uU][tT][iI][nN][eE] '/'subroutine d4_'/g | sed -e s/'callphys.def'/'callphysd4_.def '/g | sed -e s/'diagfi.nc'/'diagfid4_.nc'/g | sed -e s/'[iI][nN][cC][lL][uU][dD][eE] "'/'include "d4_'/g | sed -e s/"[iI][nN][cC][lL][uU][dD][eE] '"/"include 'd4_"/g | sed -e s+"[cC][oO][mM][mM][oO][nN]/"+"common/d4_"+g | sed -e s+"[cC][oO][mM][mM][oO][nN] /"+"common /d4_"+g | sed -e s+"d4_netcdf.inc"+"netcdf.inc"+g > d4_${1} 
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.100.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.100.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.100.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=100
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.104.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.104.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.104.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=104
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.120.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.120.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.120.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=120
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.150.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.150.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.150.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=150
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.200.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.200.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.200.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=200
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.24.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.24.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.24.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=24
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.60.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.60.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.60.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.61.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.61.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.61.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=61
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.64.48.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.64.48.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/dimensions.64.48.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/makdim
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/makdim	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/dimension/makdim	(revision 46)
@@ -0,0 +1,66 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+ if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+
+#  while [ "$n2" -gt 2 ]; do
+#      n2=`expr $n2 / 2`
+#     ndm=`expr $ndm + 1`
+#   done
+#   if [ "$n2" != 2 ] ; then
+#      echo le nombre de longitude doit etre une puissance de 2
+#      exit
+#   fi
+
+ else if [ $# -ge 2 ] ; then
+      im=1
+       jm=$1
+      lm=$2
+      ndm=1
+ else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+ else
+         echo il faut au moins une dimension
+         exit
+ fi
+fi
+fi
+
+cat << EOF > $fichdim
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= $im
+      INTEGER, parameter :: jjm=$jm
+      INTEGER, parameter :: llm=$lm
+      INTEGER, parameter :: ndm=$ndm
+
+      integer, parameter :: nqmx=$nqmx
+
+!-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_new.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_new.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_new.h	(revision 46)
@@ -0,0 +1,21 @@
+c--------------------------------------------------------------
+         REAL ripx
+         REAL fx,fxprim,fy,fyprim,ri,rj,bigy
+c
+c....stretching in x...
+c
+        ripx(  ri )= (ri-1.0) *2.*pi/FLOAT(iim) 
+        fx  (  ri )= ripx(ri) + transx  +
+     *         alphax * SIN( ripx(ri)+transx-pxo ) - pi
+        fxprim(ri) = 2.*pi/FLOAT(iim)  *
+     *        ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) )
+
+c....stretching in y...
+c
+        bigy(rj)   = 2.* (FLOAT(jjp1)-rj) *pi/jjm
+        fy(rj)     =  ( bigy(rj) + transy  +
+     *        alphay * SIN( bigy(rj)+transy-pyo ) ) /2.  - pi/2.
+        fyprim(rj) = ( pi/jjm ) * ( 1.+
+     *           alphay * COS( bigy(rj)+transy-pyo ) )
+
+c--------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_reg.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_reg.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_reg.h	(revision 46)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_sin.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_sin.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxy_sin.h	(revision 46)
@@ -0,0 +1,39 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+      fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxyprim.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxyprim.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/grid/fxyprim.h	(revision 46)
@@ -0,0 +1,42 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'fxyprim.h'
+c
+c    ................................................................
+c    ................  Fonctions in line  ...........................
+c    ................................................................
+c
+      REAL  fy, fx, fxprim, fyprim
+      REAL  ri, rj
+c
+c
+      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/FLOAT(jjm)
+
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
+
+      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/FLOAT(iim)
+c
+c
+c    La valeur de pi est passee par le common/const/ou /const2/ .
+c    Sinon, il faut la calculer avant d'appeler ces fonctions .
+c
+c   ----------------------------------------------------------------
+c     Fonctions a changer eventuellement, selon x(x) et y(y) choisis .
+c   -----------------------------------------------------------------
+c
+c    .....  ici, on a l'application particuliere suivante   ........
+c
+c                **************************************
+c                **     x = 2. * pi/iim *  X         **
+c                **     y =      pi/jjm *  Y         **
+c                **************************************
+c
+c   ..................................................................
+c   ..................................................................
+c
+c
+c
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerave.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerave.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerave.F	(revision 46)
@@ -0,0 +1,194 @@
+      SUBROUTINE aerave ( ndata,
+     & longdata,epdata,omegdata,gdata,          
+     &            longref,epref,temp,nir,longir
+     &            ,epir,omegir,gir,qref,omegaref        )
+      IMPLICIT NONE
+c.......................................................................
+c
+c R.Fournier 02/1996 
+c (modif F.Forget 02/1996)
+c le spectre est decoupe en "nir" bandes et cette routine calcule
+c les donnees radiatives moyenne sur chaque bande : l'optimisation
+c est faite pour une temperature au sol "temp" et une epaisseur
+c optique de l'atmosphere "epref" a la longueur d'onde "longref"
+c
+c dans la version actuelle, les ponderations sont independantes de
+c l'epaisseur optique : c'est a dire que "omegir", "gir"
+c et "epir/epre" sont independants de "epref".
+c en effet les ponderations sont choisies pour une solution exacte
+c en couche mince et milieu isotherme. 
+c
+c entree
+c
+c    ndata : taille des champs data
+c    longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
+c                  (longdata longueur d'onde en METRES)
+c  * longref : longueur d'onde a laquelle l'epaisseur optique
+c              est connue
+c  * epref : epaisseur optique a longref
+c  * temp : temperature choisie pour la ponderation (Planck)
+c  * nir : nombre d'intervals dans la discretisation spectrale
+c           du GCM
+c  * longir : longueurs d'onde definissant ces intervals
+c
+c sortie
+c
+c  * epir : epaisseur optique moyenne pour chaque interval
+c  * omegir : "scattering albedo" moyen pour chaque interval
+c  * gir : "assymetry factor" moyen pour chaque interval
+c  * qref : extinction coefficient at reference wavelength
+c  * omegaref : single scat. albedo at reference wavelength
+c
+c.......................................................................
+c
+      REAL longref
+      REAL epref
+      REAL temp
+      INTEGER nir
+      REAL longir(nir+1)
+      REAL epir(nir)
+      REAL omegir(nir)
+      REAL gir(nir)
+c
+c.......................................................................
+c
+      INTEGER iir,nirmx
+      PARAMETER (nirmx=100)
+      INTEGER idata,ndata
+c
+c.......................................................................
+c
+      REAL emit
+      REAL totalemit(nirmx)
+      REAL longdata(ndata),epdata(ndata)
+     &    ,omegdata(ndata),gdata(ndata)
+      REAL qextcorrdata(ndata)
+      INTEGER ibande,nbande
+      PARAMETER (nbande=1000)
+      REAL long,deltalong
+      INTEGER ilong
+      INTEGER i1,i2
+      REAL c1,c2
+      REAL factep,qextcorr,omeg,g
+      REAL qref,omegaref
+c
+c.......................................................................
+c
+      DOUBLE PRECISION tmp1
+      REAL tmp2,tmp3
+c
+c
+      long=longref
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+      qref=c1*epdata(i1)+c2*epdata(i2)
+      omegaref=c1*omegdata(i1)+c2*omegdata(i2)
+      factep=qref/epref
+      DO idata=1,ndata
+        qextcorrdata(idata)=epdata(idata)/factep
+      ENDDO
+c
+c.......................................................................
+c
+      DO iir=1,nir
+c
+c.......................................................................
+c
+        deltalong=(longir(iir+1)-longir(iir)) / nbande
+        totalemit(iir)=0.E+0
+        epir(iir)=0.E+0
+        omegir(iir)=0.E+0
+        gir(iir)=0.E+0
+c
+c.......................................................................
+c
+        DO ibande=1,nbande
+c
+c.......................................................................
+c
+          long=longir(iir) + (ibande-0.5E+0) * deltalong
+          CALL blackl(DBLE(long),DBLE(temp),tmp1)
+          emit=REAL(tmp1)
+c
+c.......................................................................
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+          qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
+          omeg=c1*omegdata(i1)+c2*omegdata(i2)
+          g=c1*gdata(i1)+c2*gdata(i2)
+c
+c.......................................................................
+c
+          totalemit(iir)=totalemit(iir)+deltalong*emit
+          epir(iir)=epir(iir)+deltalong*emit*qextcorr
+          omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
+          gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
+c
+c.......................................................................
+c
+        ENDDO
+c
+c.......................................................................
+c
+        gir(iir)=gir(iir)/omegir(iir)
+        omegir(iir)=omegir(iir)/epir(iir)
+        epir(iir)=epir(iir)/totalemit(iir)
+c
+c.......................................................................
+c
+      ENDDO
+c
+c......................................................................
+c
+c     Diagnostic de controle si on moyenne sur tout le spectre vis ou IR :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     tmp2=0.E+0
+c     DO iir=1,nir
+c       tmp2=tmp2+totalemit(iir)
+c     ENDDO
+c     tmp3=5.67E-8 * temp**4
+c     IF (abs((tmp2-tmp3)/tmp3).gt.0.05E+0) THEN
+c       PRINT *,'!!!! <---> il manque du Planck (voir moyenne.F)'
+c       PRINT *,'somme des bandes :',tmp2,'--- Planck:',tmp3
+c     ENDIF
+c
+c......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdata.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdata.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdata.h	(revision 46)
@@ -0,0 +1,134 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+c visible (Clancy and Lee, 1991)
+      integer ndatavis
+      parameter(ndatavis=2)
+      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndatair
+      parameter(ndatair=124)
+      REAL longdatair(ndatair),epdatair(ndatair)
+     &    ,omegdatair(ndatair),gdatair(ndatair)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdatavis/
+     & 0.210000E-06,0.414800E-05/
+      data epdatavis/2.5,2.5/
+      data omegdatavis/0.92,0.92/
+      data gdatavis/0.55,0.55/
+      data longdatair/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdatair/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdatair/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdatair/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h	(revision 46)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.clan91
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.clan91	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.clan91	(revision 46)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.ocke97
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.ocke97	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerdust.h.ocke97	(revision 46)
@@ -0,0 +1,167 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+
+c visible (composite; Ockert-Bell, 1996)
+!      integer ndatavis
+!      parameter(ndatavis=22)
+!      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+!     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+      integer ndustvis
+      parameter(ndustvis=22)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+!      integer ndatair
+!      parameter(ndatair=124)
+!      REAL longdatair(ndatair),epdatair(ndatair)
+!     &    ,omegdatair(ndatair),gdatair(ndatair)
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+!      data longdatavis/
+      data longdustvis/
+     & 0.210000E-06,0.300000E-06,0.350000E-06,0.396000E-06,0.500000E-06
+     &,0.596000E-06,0.670000E-06,0.700000E-06,0.802000E-06,0.101500E-05
+     &,0.121000E-05,0.138800E-05,0.219600E-05,0.249000E-05,0.289800E-05
+     &,0.300000E-05,0.319300E-05,0.339600E-05,0.360400E-05,0.377600E-05
+     &,0.398000E-05,0.414800E-05/
+!      data epdatavis/
+      data epdustvis/
+     & 2.6279900,2.5766001,2.5974200,2.6333699,2.8306701
+     &,2.9744799,3.0389600,3.0630300,3.1325400,3.2430501
+     &,3.3174801,3.3595500,3.2457900,3.1078401,2.7780800
+     &,2.7713201,2.7360499,2.6556201,2.5405700,2.4204800
+     &,2.2459800,1.9280800/
+!      data omegdatavis/
+      data omegdustvis/
+     & 0.7495430,0.6030650,0.5962170,0.6119930,0.7942140
+     &,0.9040160,0.9288640,0.9370630,0.9486390,0.9521170
+     &,0.9540560,0.9558040,0.9550000,0.9511820,0.8042000
+     &,0.8244980,0.8807870,0.9260230,0.9545540,0.9594400
+     &,0.9581870,0.8693700/
+!      data gdatavis/
+      data gdustvis/
+     & 0.7858040,0.8816350,0.8781190,0.8550090,0.7232660
+     &,0.6684300,0.6547490,0.6502400,0.6412210,0.6326590
+     &,0.6283010,0.6261290,0.6281390,0.6306530,0.6707820
+     &,0.6652110,0.6506370,0.6400950,0.6341580,0.6334550
+     &,0.6341640,0.6506680/
+!      data longdatair/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+!      data epdatair/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+!      data omegdatair/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+!      data gdatair/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.005
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.005	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.005	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 0.5 MICRONS (Franck Montmessin) 
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=65.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=.5e-6,qrefice=2.8)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1832037,3.0220087,2.4477277,1.7936502,0.7896869,
+     &0.3638896,0.0989704,0.1296485,0.4747359,0.6042269,
+     &0.7391522,0.8270491,0.9101521,1.0053538,1.1204786,
+     &1.2478381,1.3907613,1.5331460,1.5983437,1.5859528,
+     &1.5294470,1.4795980,1.4226713,1.3357474,1.2130061,
+     &1.0765146,0.9549081,0.8522044,0.7333566,0.6579455,
+     &0.5836973,0.5145633,0.4580996,0.4042850,0.3620397,
+     &0.3252469,0.2931417,0.2685316,0.2455204,0.2259372,
+     &0.2092481,0.1779757,0.1460140,0.1362165,0.1238611,
+     &0.1114724,0.1013308,0.0958610,0.0989326,0.1026265,
+     &0.1056360,0.1088488,0.1078976,0.1089309,0.1056082,
+     &0.0775238,0.0604925,0.0548426/
+       data epiceir/
+     &0.0518859,0.0499921,0.0489281,0.0504541,0.0563693,
+     &0.0690525,0.0726885,0.0778081,0.0828819,0.0909149,
+     &0.0975723,0.1109497,0.1108328,0.1043100,0.1007861,
+     &0.0985987,0.0951375,0.0903377,0.0868122,0.0846175,
+     &0.0815860,0.0824196,0.0820647,0.0784795,0.0737793,
+     &0.0722562,0.0696436,0.0659283,0.0645018,0.0631230,
+     &0.0617881,0.0583767,0.0540010,0.0487309,0.0435927,
+     &0.0405531,0.0414796,0.0409568,0.0413717,0.0422409,
+     &0.0421894,0.0416819,0.0412459,0.0438362,0.0547753,
+     &0.0626479,0.0729752,0.0890032,0.1097846,0.1367236,
+     &0.1645632,0.1977923,0.2204414,0.2592581,0.2749909,
+     &0.2818336,0.2731296,0.2562519,0.2294758,0.2146772,
+     &0.2003647,0.1846708,0.1704422,0.1563350,0.1425573,
+     &0.1287259,0.1145926,0.0897004,0.0727098,0.0659172,
+     &0.0615737,0.0541199,0.0521104,0.0503624,0.0466379,
+     &0.0422906,0.0299038,0.0264714,0.0274238,0.0264572,
+     &0.0231405,0.0186739,0.0150726,0.0092988,0.0087124,
+     &0.0084247,0.0083568,0.0085502,0.0087600,0.0096209,
+     &0.0139307,0.0186971,0.0250932,0.0314043,0.0401234,
+     &0.0493907,0.0591965,0.0683152,0.0781187,0.0888679,
+     &0.0974246,0.1010759,0.1059724,0.1067670,0.1021143,
+     &0.0896822,0.0784708,0.0693838,0.0645370,0.0599980,
+     &0.0540903,0.0504870,0.0469609,0.0408812,0.0363856,
+     &0.0326679,0.0299615,0.0284745,0.0328476,0.0366500,
+     &0.0404568,0.0452998,0.0461202,0.0442455,0.0428461,
+     &0.0412572,0.0394165,0.0369267,0.0336194,0.0301124,
+     &0.0269362,0.0227761,0.0199896,0.0184862,0.0138242,
+     &0.0116880,0.0108555,0.0101642,0.0089899,0.0079631,
+     &0.0071303,0.0051857,0.0033162,0.0025556/
+       data omegicevis/
+     &0.5254589,1.0000000,0.9999991,0.9999862,0.9916013,
+     &0.9620332,0.9309642,0.0638710,0.0662553,0.0823147,
+     &0.0963694,0.1048159,0.1133009,0.1232222,0.1352970,
+     &0.1488444,0.1650357,0.1841903,0.2017575,0.2166039,
+     &0.2292029,0.2433622,0.2616843,0.2852339,0.3131889,
+     &0.3412718,0.3660752,0.3928272,0.4309901,0.4492646,
+     &0.4801873,0.5139056,0.5460804,0.5844365,0.6146011,
+     &0.6468718,0.6772872,0.6975922,0.7236167,0.7461668,
+     &0.7655625,0.7888166,0.7862524,0.7823967,0.7588729,
+     &0.6857340,0.6214526,0.5368491,0.4470918,0.4119983,
+     &0.3805366,0.3541514,0.3503601,0.3458159,0.3562116,
+     &0.4411552,0.4703839,0.4680012/
+       data omegiceir/
+     &0.4410178,0.4089485,0.3886294,0.3210695,0.2419387,
+     &0.1693097,0.1560958,0.1421160,0.1303703,0.1174139,
+     &0.1096975,0.0955347,0.0956753,0.0990973,0.1009341,
+     &0.1015035,0.1034342,0.1062110,0.1070629,0.1064178,
+     &0.1036404,0.0972966,0.0935797,0.0912126,0.0893898,
+     &0.0863554,0.0848208,0.0840290,0.0804088,0.0772171,
+     &0.0744647,0.0741630,0.0747523,0.0763844,0.0774963,
+     &0.0745925,0.0657440,0.0572360,0.0481501,0.0421850,
+     &0.0375024,0.0306774,0.0232991,0.0167966,0.0100478,
+     &0.0075047,0.0055527,0.0042542,0.0036752,0.0036866,
+     &0.0039804,0.0045186,0.0049973,0.0059663,0.0067372,
+     &0.0074513,0.0081464,0.0088094,0.0094550,0.0097817,
+     &0.0101162,0.0104466,0.0107313,0.0110585,0.0114425,
+     &0.0118786,0.0123615,0.0132487,0.0135842,0.0136287,
+     &0.0132877,0.0127042,0.0121676,0.0117236,0.0118197,
+     &0.0120773,0.0129020,0.0118840,0.0105257,0.0101722,
+     &0.0107762,0.0121118,0.0133881,0.0149663,0.0144329,
+     &0.0133009,0.0117145,0.0090358,0.0080348,0.0058144,
+     &0.0023043,0.0010388,0.0004725,0.0003068,0.0002241,
+     &0.0001846,0.0001716,0.0001686,0.0001696,0.0001738,
+     &0.0001855,0.0001962,0.0002120,0.0002308,0.0002526,
+     &0.0002702,0.0002761,0.0002683,0.0002543,0.0002499,
+     &0.0002511,0.0002545,0.0002619,0.0002746,0.0002779,
+     &0.0002773,0.0002686,0.0002502,0.0001890,0.0001591,
+     &0.0001434,0.0001354,0.0001372,0.0001437,0.0001462,
+     &0.0001491,0.0001526,0.0001578,0.0001639,0.0001681,
+     &0.0001709,0.0001735,0.0001751,0.0001759,0.0001954,
+     &0.0001839,0.0001755,0.0001695,0.0001556,0.0001422,
+     &0.0001276,0.0000821,0.0000525,0.0000447/
+       data gicevis/
+     &0.9440147,0.7965972,0.8107608,0.7669883,0.6258456,
+     &0.4763368,0.3164644,0.2653029,0.2540545,0.2543145,
+     &0.2552853,0.2555421,0.2551991,0.2546355,0.2543354,
+     &0.2544852,0.2551972,0.2571523,0.2610470,0.2657359,
+     &0.2696103,0.2723087,0.2749877,0.2770225,0.2766140,
+     &0.2729803,0.2674728,0.2618006,0.2547111,0.2485000,
+     &0.2423996,0.2361834,0.2305830,0.2249461,0.2198020,
+     &0.2149920,0.2103154,0.2060570,0.2018775,0.1979253,
+     &0.1941856,0.1853729,0.1727509,0.1681767,0.1610373,
+     &0.1502239,0.1399678,0.1301550,0.1233758,0.1211795,
+     &0.1180928,0.1149843,0.1129097,0.1123236,0.1113603,
+     &0.1042673,0.0958210,0.0918495/
+       data giceir/
+     &0.0879977,0.0844017,0.0822360,0.0778328,0.0732655,
+     &0.0690960,0.0682752,0.0674878,0.0666989,0.0659700,
+     &0.0653013,0.0618198,0.0604822,0.0583973,0.0576873,
+     &0.0569741,0.0562715,0.0555336,0.0547710,0.0540252,
+     &0.0525653,0.0511566,0.0498082,0.0478042,0.0458238,
+     &0.0445190,0.0432495,0.0419659,0.0407013,0.0394739,
+     &0.0382847,0.0371085,0.0359234,0.0347448,0.0335567,
+     &0.0323681,0.0312087,0.0295399,0.0279082,0.0268502,
+     &0.0258095,0.0242507,0.0226832,0.0216094,0.0205569,
+     &0.0199994,0.0194464,0.0189064,0.0183935,0.0179262,
+     &0.0174721,0.0170318,0.0167252,0.0161173,0.0156093,
+     &0.0151735,0.0148010,0.0144899,0.0141909,0.0140236,
+     &0.0138500,0.0136646,0.0134407,0.0131990,0.0129545,
+     &0.0126989,0.0123981,0.0117364,0.0110220,0.0106622,
+     &0.0102900,0.0096114,0.0092885,0.0089773,0.0086913,
+     &0.0084029,0.0075082,0.0069195,0.0066498,0.0064030,
+     &0.0061638,0.0059125,0.0056564,0.0049044,0.0047217,
+     &0.0045194,0.0042905,0.0039171,0.0037807,0.0034683,
+     &0.0028199,0.0023535,0.0019931,0.0018378,0.0017011,
+     &0.0015627,0.0014514,0.0013460,0.0012398,0.0011386,
+     &0.0010917,0.0010505,0.0010140,0.0010014,0.0010106,
+     &0.0010385,0.0010523,0.0010404,0.0009990,0.0009673,
+     &0.0009376,0.0009252,0.0009159,0.0009061,0.0008860,
+     &0.0008628,0.0008361,0.0008086,0.0007567,0.0007210,
+     &0.0006967,0.0006727,0.0006705,0.0006603,0.0006463,
+     &0.0006386,0.0006316,0.0006257,0.0006182,0.0006034,
+     &0.0005850,0.0005536,0.0005284,0.0005128,0.0004754,
+     &0.0004328,0.0004100,0.0003918,0.0003559,0.0003223,
+     &0.0002906,0.0002006,0.0001287,0.0001043/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.01
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.01	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.01	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 1 MICRONS (Franck M ontmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=23.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-6,qrefice=2.75)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1192634,2.3866904,3.0710473,3.2044775,2.4812233,
+     &1.5408986,0.5308650,0.2823303,0.8151994,0.9982054,
+     &1.1776563,1.2913215,1.3945227,1.5075399,1.6387790,
+     &1.7810757,1.9404513,2.1077142,2.2311430,2.3039091,
+     &2.3424239,2.3839264,2.4322689,2.4745319,2.4916942,
+     &2.4703403,2.4206913,2.3665223,2.2752666,2.1747661,
+     &2.0781898,1.9706942,1.8699772,1.7651500,1.6681471,
+     &1.5780047,1.4902014,1.4125437,1.3384955,1.2692254,
+     &1.2053254,1.0666140,0.9020291,0.8492430,0.7754933,
+     &0.6846126,0.6097632,0.5495253,0.5234407,0.5223706,
+     &0.5196257,0.5199762,0.5163358,0.5186846,0.5133317,
+     &0.4363440,0.3637202,0.3336293/
+       data epiceir/
+     &0.3097547,0.2899992,0.2780589,0.2617716,0.2548404,
+     &0.2650286,0.2694660,0.2773825,0.2855305,0.3007740,
+     &0.3150952,0.3452618,0.3475289,0.3352611,0.3274985,
+     &0.3222899,0.3144871,0.3029351,0.2930705,0.2859025,
+     &0.2744837,0.2721885,0.2687397,0.2570274,0.2420578,
+     &0.2354512,0.2268017,0.2151964,0.2083238,0.2020417,
+     &0.1963370,0.1862280,0.1736113,0.1585643,0.1430934,
+     &0.1316877,0.1294224,0.1228625,0.1185373,0.1171891,
+     &0.1139945,0.1080297,0.1016796,0.1029433,0.1216047,
+     &0.1356978,0.1546041,0.1849135,0.2246722,0.2768484,
+     &0.3310658,0.3965377,0.4426499,0.5253468,0.5668955,
+     &0.5922215,0.5880766,0.5654298,0.5190575,0.4913011,
+     &0.4635427,0.4314885,0.4015174,0.3712321,0.3411348,
+     &0.3102629,0.2780339,0.2194865,0.1779260,0.1610434,
+     &0.1496597,0.1303599,0.1247039,0.1198948,0.1110008,
+     &0.1007371,0.0712706,0.0622413,0.0636172,0.0611146,
+     &0.0536605,0.0437097,0.0355698,0.0220631,0.0205425,
+     &0.0196398,0.0191828,0.0191171,0.0193923,0.0208254,
+     &0.0290338,0.0383325,0.0509648,0.0635566,0.0810146,
+     &0.0995692,0.1192388,0.1375636,0.1572995,0.1789836,
+     &0.1963544,0.2039599,0.2141546,0.2161427,0.2071475,
+     &0.1822319,0.1595332,0.1409966,0.1310656,0.1218277,
+     &0.1098314,0.1025169,0.0953714,0.0830212,0.0738609,
+     &0.0662767,0.0607402,0.0576721,0.0664149,0.0740372,
+     &0.0816919,0.0914682,0.0931417,0.0893927,0.0865822,
+     &0.0833833,0.0796740,0.0746523,0.0679690,0.0608707,
+     &0.0544375,0.0460094,0.0403652,0.0373210,0.0279000,
+     &0.0235664,0.0218776,0.0204772,0.0180988,0.0160214,
+     &0.0143370,0.0104088,0.0066479,0.0051210/
+       data omegicevis/
+     &0.5386420,1.0000000,0.9999983,0.9999850,0.9955066,
+     &0.9844767,0.9774309,0.1614970,0.1627708,0.1939070,
+     &0.2183838,0.2320055,0.2452919,0.2601796,0.2772272,
+     &0.2949594,0.3144796,0.3355922,0.3536791,0.3691771,
+     &0.3833629,0.3993029,0.4197326,0.4469427,0.4815640,
+     &0.5188605,0.5528998,0.5873977,0.6337127,0.6578971,
+     &0.6923810,0.7275212,0.7585961,0.7921193,0.8169167,
+     &0.8410107,0.8620409,0.8756065,0.8913837,0.9042724,
+     &0.9147988,0.9275904,0.9291340,0.9284223,0.9196891,
+     &0.8876197,0.8561562,0.8072060,0.7431433,0.7140535,
+     &0.6865323,0.6620798,0.6595058,0.6550942,0.6665309,
+     &0.7495020,0.7778903,0.7786440/
+       data omegiceir/
+     &0.7604749,0.7366999,0.7205958,0.6580536,0.5668025,
+     &0.4587096,0.4356672,0.4097329,0.3868122,0.3598266,
+     &0.3431242,0.3130278,0.3147338,0.3254214,0.3307036,
+     &0.3329236,0.3383887,0.3458877,0.3488805,0.3483467,
+     &0.3436954,0.3301307,0.3225699,0.3191252,0.3170218,
+     &0.3108034,0.3083988,0.3079879,0.2998554,0.2926259,
+     &0.2863949,0.2870713,0.2903223,0.2965344,0.3012683,
+     &0.2946250,0.2699749,0.2452659,0.2165022,0.1961797,
+     &0.1795562,0.1537112,0.1230571,0.0931165,0.0588126,
+     &0.0449536,0.0339055,0.0263423,0.0229347,0.0230562,
+     &0.0248910,0.0281887,0.0311059,0.0369957,0.0417154,
+     &0.0460758,0.0503238,0.0543560,0.0582899,0.0602842,
+     &0.0623192,0.0643389,0.0661152,0.0681381,0.0704755,
+     &0.0731053,0.0760185,0.0814240,0.0838108,0.0843268,
+     &0.0827206,0.0799519,0.0771474,0.0748236,0.0755603,
+     &0.0772232,0.0825206,0.0770989,0.0693231,0.0673670,
+     &0.0711028,0.0790820,0.0865735,0.0959862,0.0931518,
+     &0.0868936,0.0778482,0.0618916,0.0556907,0.0414274,
+     &0.0172511,0.0079517,0.0036608,0.0023874,0.0017483,
+     &0.0014435,0.0013443,0.0013223,0.0013315,0.0013663,
+     &0.0014583,0.0015426,0.0016673,0.0018146,0.0019850,
+     &0.0021217,0.0021683,0.0021083,0.0019995,0.0019657,
+     &0.0019761,0.0020031,0.0020611,0.0021607,0.0021879,
+     &0.0021838,0.0021172,0.0019728,0.0014927,0.0012580,
+     &0.0011338,0.0010718,0.0010859,0.0011371,0.0011565,
+     &0.0011796,0.0012070,0.0012485,0.0012965,0.0013299,
+     &0.0013524,0.0013734,0.0013868,0.0013938,0.0015480,
+     &0.0014583,0.0013921,0.0013452,0.0012361,0.0011303,
+     &0.0010147,0.0006545,0.0004192,0.0003572/
+       data gicevis/
+     &0.9472355,0.7817819,0.8104869,0.8370932,0.8250610,
+     &0.7729445,0.6907796,0.6560782,0.6408569,0.6389719,
+     &0.6383793,0.6379554,0.6365179,0.6343526,0.6319877,
+     &0.6300194,0.6284310,0.6279051,0.6303032,0.6338103,
+     &0.6368135,0.6378741,0.6381156,0.6375306,0.6352661,
+     &0.6311954,0.6260597,0.6201031,0.6121832,0.6065006,
+     &0.5996023,0.5927197,0.5867192,0.5807193,0.5757619,
+     &0.5710542,0.5665758,0.5626292,0.5584362,0.5544021,
+     &0.5504646,0.5406969,0.5247300,0.5183126,0.5077586,
+     &0.4904415,0.4721469,0.4530136,0.4389606,0.4342998,
+     &0.4274060,0.4202327,0.4151474,0.4137563,0.4111845,
+     &0.3915503,0.3674690,0.3556202/
+       data giceir/
+     &0.3438542,0.3325318,0.3255288,0.3110588,0.2956603,
+     &0.2814386,0.2786329,0.2760077,0.2733599,0.2710718,
+     &0.2689575,0.2567067,0.2516982,0.2434593,0.2405528,
+     &0.2376774,0.2347744,0.2316430,0.2284427,0.2253558,
+     &0.2193370,0.2136727,0.2081797,0.1998119,0.1914108,
+     &0.1859097,0.1804893,0.1749370,0.1695419,0.1642952,
+     &0.1592050,0.1540809,0.1488775,0.1436688,0.1384313,
+     &0.1332790,0.1283971,0.1213205,0.1144493,0.1100211,
+     &0.1056500,0.0991218,0.0926120,0.0882538,0.0841548,
+     &0.0820158,0.0799326,0.0779781,0.0761736,0.0745909,
+     &0.0730158,0.0714981,0.0703739,0.0679849,0.0657191,
+     &0.0636815,0.0617775,0.0601208,0.0585010,0.0576308,
+     &0.0567537,0.0558357,0.0547788,0.0536580,0.0525378,
+     &0.0513812,0.0500444,0.0471741,0.0441685,0.0426759,
+     &0.0411515,0.0383862,0.0370815,0.0358252,0.0346632,
+     &0.0334926,0.0298874,0.0275405,0.0264717,0.0254866,
+     &0.0245280,0.0235218,0.0225007,0.0195162,0.0187928,
+     &0.0179918,0.0170857,0.0156065,0.0150664,0.0138279,
+     &0.0112556,0.0094019,0.0079691,0.0073517,0.0068074,
+     &0.0062553,0.0058107,0.0053889,0.0049634,0.0045574,
+     &0.0043685,0.0042020,0.0040541,0.0040013,0.0040349,
+     &0.0041445,0.0041994,0.0041524,0.0039878,0.0038609,
+     &0.0037426,0.0036932,0.0036563,0.0036177,0.0035376,
+     &0.0034454,0.0033390,0.0032297,0.0030226,0.0028803,
+     &0.0027832,0.0026872,0.0026783,0.0026373,0.0025813,
+     &0.0025507,0.0025227,0.0024990,0.0024694,0.0024103,
+     &0.0023370,0.0022120,0.0021112,0.0020491,0.0019000,
+     &0.0017298,0.0016389,0.0015661,0.0014226,0.0012886,
+     &0.0011617,0.0008021,0.0005148,0.0004169/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.02
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.02	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.02	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 2 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=5.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=2.e-6,qrefice=2.55)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0770404,2.1333470,2.4010422,2.4979005,3.0323684,
+     &3.1023693,1.8456773,0.6115797,1.2549678,1.4533914,
+     &1.6278559,1.7319367,1.8213371,1.9134820,2.0143185,
+     &2.1186094,2.2303414,2.3434513,2.4327984,2.4951937,
+     &2.5413978,2.5864980,2.6369226,2.6951535,2.7622788,
+     &2.8332534,2.8984516,2.9598370,3.0300596,3.0575798,
+     &3.0930560,3.1250999,3.1535439,3.1871719,3.2121134,
+     &3.2310603,3.2315695,3.2093773,3.1794426,3.1392601,
+     &3.0919006,2.9505072,2.7231605,2.6405320,2.5163631,
+     &2.3446450,2.1814499,2.0090101,1.8916085,1.8633907,
+     &1.8338290,1.8152963,1.8086077,1.8112632,1.8131738,
+     &1.7060630,1.5370420,1.4517928/
+       data epiceir/
+     &1.3677877,1.2895485,1.2393701,1.1429415,1.0560902,
+     &1.0034354,0.9967221,0.9962561,0.9977396,1.0125090,
+     &1.0341120,1.0880692,1.1033542,1.0976548,1.0879265,
+     &1.0804520,1.0700891,1.0510827,1.0297735,1.0111766,
+     &0.9773523,0.9594117,0.9459089,0.9159908,0.8764862,
+     &0.8542295,0.8300154,0.7979962,0.7717778,0.7486199,
+     &0.7285973,0.7015588,0.6676357,0.6260576,0.5785204,
+     &0.5338926,0.5080446,0.4684776,0.4333192,0.4139500,
+     &0.3915187,0.3532456,0.3098173,0.2878825,0.3012615,
+     &0.3171561,0.3421502,0.3891775,0.4544489,0.5433146,
+     &0.6361080,0.7489142,0.8315196,0.9866923,1.0865711,
+     &1.1662428,1.2104664,1.2263397,1.2011900,1.1775792,
+     &1.1506165,1.1109692,1.0695655,1.0244781,0.9760489,
+     &0.9209963,0.8573869,0.7222608,0.6077753,0.5570301,
+     &0.5179734,0.4515876,0.4286255,0.4101167,0.3839801,
+     &0.3538276,0.2605970,0.2226936,0.2192847,0.2094082,
+     &0.1883334,0.1602530,0.1354466,0.0878593,0.0806558,
+     &0.0747401,0.0696599,0.0635099,0.0620812,0.0608565,
+     &0.0708767,0.0859044,0.1087823,0.1332179,0.1678403,
+     &0.2047173,0.2441402,0.2811615,0.3213149,0.3657669,
+     &0.4021912,0.4198142,0.4433846,0.4508493,0.4361142,
+     &0.3870594,0.3401732,0.3004933,0.2788217,0.2592098,
+     &0.2339364,0.2185203,0.2035674,0.1773828,0.1576549,
+     &0.1412068,0.1290261,0.1220045,0.1392276,0.1544823,
+     &0.1700448,0.1902850,0.1939131,0.1865104,0.1808444,
+     &0.1743156,0.1667072,0.1563581,0.1424541,0.1275658,
+     &0.1140205,0.0962364,0.0843266,0.0779076,0.0582227,
+     &0.0489812,0.0453767,0.0424055,0.0373608,0.0329743,
+     &0.0294211,0.0211810,0.0134449,0.0103372/
+       data omegicevis/
+     &0.5456115,0.9999998,0.9999956,0.9999590,0.9916146,
+     &0.9859025,0.9887677,0.3030088,0.2913164,0.3281876,
+     &0.3529492,0.3651998,0.3768913,0.3895164,0.4031501,
+     &0.4161578,0.4291025,0.4413079,0.4489263,0.4537341,
+     &0.4575938,0.4624165,0.4686106,0.4772439,0.4906920,
+     &0.5103999,0.5342540,0.5620137,0.6054875,0.6363699,
+     &0.6767519,0.7208792,0.7611457,0.8031358,0.8346425,
+     &0.8628765,0.8866344,0.9024555,0.9187659,0.9315375,
+     &0.9414928,0.9542499,0.9594395,0.9604324,0.9575609,
+     &0.9427309,0.9280359,0.9029658,0.8663382,0.8482844,
+     &0.8309193,0.8149818,0.8138757,0.8108203,0.8191826,
+     &0.8778344,0.8991383,0.9015617/
+       data omegiceir/
+     &0.8934232,0.8818511,0.8737661,0.8382167,0.7786070,
+     &0.6939076,0.6735601,0.6493360,0.6269631,0.5988325,
+     &0.5805314,0.5477262,0.5506567,0.5654900,0.5726005,
+     &0.5761235,0.5833758,0.5930895,0.5978242,0.5985849,
+     &0.5960529,0.5830086,0.5764220,0.5759224,0.5773382,
+     &0.5725862,0.5723791,0.5748378,0.5679526,0.5619652,
+     &0.5570325,0.5608990,0.5682156,0.5793377,0.5887846,
+     &0.5845600,0.5571433,0.5294130,0.4933869,0.4654703,
+     &0.4418373,0.4019260,0.3476712,0.2847430,0.1985389,
+     &0.1588668,0.1246927,0.0997362,0.0880947,0.0885516,
+     &0.0949879,0.1061776,0.1158887,0.1351058,0.1506025,
+     &0.1648239,0.1789169,0.1923770,0.2058806,0.2128322,
+     &0.2198936,0.2270511,0.2336397,0.2410020,0.2492446,
+     &0.2583708,0.2685325,0.2880028,0.2994628,0.3033591,
+     &0.3015518,0.2984661,0.2927081,0.2880204,0.2918781,
+     &0.2983889,0.3187046,0.3071705,0.2860579,0.2815239,
+     &0.2940739,0.3184738,0.3403679,0.3687520,0.3625693,
+     &0.3473680,0.3237919,0.2777646,0.2580903,0.2082118,
+     &0.1032983,0.0523547,0.0255129,0.0169770,0.0125923,
+     &0.0104937,0.0098291,0.0097139,0.0098247,0.0101194,
+     &0.0108076,0.0114394,0.0123597,0.0134295,0.0146494,
+     &0.0156162,0.0159481,0.0155375,0.0147876,0.0145659,
+     &0.0146613,0.0148656,0.0152911,0.0160210,0.0162369,
+     &0.0162299,0.0157726,0.0147472,0.0112574,0.0095320,
+     &0.0086141,0.0081565,0.0082618,0.0086479,0.0087967,
+     &0.0089716,0.0091790,0.0094908,0.0098519,0.0101090,
+     &0.0102865,0.0104608,0.0105742,0.0106353,0.0118091,
+     &0.0111652,0.0106810,0.0103373,0.0095315,0.0087433,
+     &0.0078753,0.0051297,0.0033094,0.0028262/
+       data gicevis/
+     &0.9484491,0.8355189,0.7778400,0.7776268,0.8190585,
+     &0.8606436,0.8731218,0.8806872,0.8701044,0.8643763,
+     &0.8590536,0.8557699,0.8518856,0.8469009,0.8408017,
+     &0.8344239,0.8276296,0.8213363,0.8196754,0.8210629,
+     &0.8234175,0.8239279,0.8233964,0.8221809,0.8193476,
+     &0.8139911,0.8067252,0.7971323,0.7828836,0.7760382,
+     &0.7660869,0.7580626,0.7531731,0.7496098,0.7489922,
+     &0.7482402,0.7481378,0.7496041,0.7509772,0.7528265,
+     &0.7546561,0.7586707,0.7610235,0.7611462,0.7609918,
+     &0.7593807,0.7559055,0.7519168,0.7489015,0.7477896,
+     &0.7452020,0.7419832,0.7389061,0.7381128,0.7358862,
+     &0.7217935,0.7082421,0.7019699/
+       data giceir/
+     &0.6960046,0.6900042,0.6861350,0.6780239,0.6687398,
+     &0.6597540,0.6579545,0.6563612,0.6546398,0.6533316,
+     &0.6517801,0.6404516,0.6350707,0.6258222,0.6224794,
+     &0.6192569,0.6158453,0.6121228,0.6084902,0.6050581,
+     &0.5983168,0.5919929,0.5853947,0.5746408,0.5632364,
+     &0.5555539,0.5475681,0.5390213,0.5306059,0.5220675,
+     &0.5134400,0.5042357,0.4944685,0.4842367,0.4735520,
+     &0.4627753,0.4524445,0.4363809,0.4197907,0.4085655,
+     &0.3969283,0.3785424,0.3589033,0.3451340,0.3322701,
+     &0.3254838,0.3188725,0.3129705,0.3078346,0.3038980,
+     &0.3000817,0.2968043,0.2943990,0.2886447,0.2820266,
+     &0.2753667,0.2682444,0.2614060,0.2542432,0.2503684,
+     &0.2464747,0.2424094,0.2378109,0.2329219,0.2279974,
+     &0.2228620,0.2168691,0.2037218,0.1898008,0.1828437,
+     &0.1758485,0.1631169,0.1571932,0.1515194,0.1461390,
+     &0.1406711,0.1239195,0.1134407,0.1088622,0.1045607,
+     &0.1002667,0.0957376,0.0912288,0.0785050,0.0754995,
+     &0.0722006,0.0684929,0.0624823,0.0602997,0.0553188,
+     &0.0450513,0.0376778,0.0319985,0.0295693,0.0274262,
+     &0.0252342,0.0234632,0.0217670,0.0200484,0.0184050,
+     &0.0176370,0.0169397,0.0163182,0.0160728,0.0161649,
+     &0.0165620,0.0167632,0.0165711,0.0159091,0.0153961,
+     &0.0149173,0.0147177,0.0145685,0.0144148,0.0140963,
+     &0.0137293,0.0133060,0.0128724,0.0120525,0.0114887,
+     &0.0111030,0.0107191,0.0106819,0.0105141,0.0102884,
+     &0.0101648,0.0100523,0.0099577,0.0098403,0.0096062,
+     &0.0093154,0.0088192,0.0084187,0.0081718,0.0075791,
+     &0.0069006,0.0065386,0.0062486,0.0056770,0.0051429,
+     &0.0046372,0.0032037,0.0020571,0.0016664/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.03
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.03	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.03	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice: PARTICLE RADIUS = 3 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.04
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.04	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.04	(revision 46)
@@ -0,0 +1,199 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 4 MICRONS (Franck Montmessin)
+
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.1E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=4.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1802000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8197000E-05,
+     &.8333000E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680000E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0854822,2.0504486,2.2594056,2.2905577,2.4309553,
+     &2.7394925,2.9738858,1.0479889,1.5827071,1.7473683,
+     &1.8791661,1.9542847,2.0162247,2.0774747,2.1420606,
+     &2.2070080,2.2746674,2.3410056,2.3915425,2.4243052,
+     &2.4465380,2.4664531,2.4864873,2.5070593,2.5285199,
+     &2.5506347,2.5724538,2.5936350,2.6196233,2.6374214,
+     &2.6572831,2.6830637,2.7173599,2.7675186,2.8233521,
+     &2.8801521,2.9195511,2.9341195,2.9565225,2.9903221,
+     &3.0211312,3.1489194,3.2117107,3.1927426,3.1992998,
+     &3.2346768,3.1870882,3.0997686,3.0240328,2.9942008,
+     &2.9638598,2.9380857,2.9347956,2.9330930,2.9452588,
+     &2.9445502,2.8607601,2.7946008/
+       data epiceir/
+     &2.7047184,2.6120941,2.5504249,2.4083079,2.2449776,
+     &2.0963051,2.0678715,2.0435539,2.0233198,2.0134084,
+     &2.0220503,2.0596078,2.0865511,2.1071296,2.1073430,
+     &2.1056444,2.1049262,2.0960135,2.0772534,2.0565253,
+     &2.0132797,1.9785371,1.9572351,1.9217145,1.8724474,
+     &1.8385008,1.8061319,1.7637404,1.7201956,1.6824483,
+     &1.6508880,1.6160781,1.5712145,1.5128543,1.4363862,
+     &1.3483616,1.2774042,1.1795400,1.0840162,1.0261202,
+     &0.9651563,0.8602540,0.7339102,0.6469975,0.6119478,
+     &0.6091090,0.6207982,0.6672347,0.7434798,0.8558041,
+     &0.9740046,1.1170480,1.2233814,1.4233819,1.5659507,
+     &1.6880697,1.7848208,1.8579589,1.8989074,1.9101462,
+     &1.9175409,1.9114984,1.8998538,1.8840935,1.8632078,
+     &1.8316492,1.7857095,1.6508096,1.4954219,1.4151742,
+     &1.3432500,1.2148845,1.1631782,1.1234219,1.0776615,
+     &1.0225006,0.8207632,0.7104143,0.6854881,0.6592867,
+     &0.6146109,0.5515194,0.4878044,0.3406532,0.3125988,
+     &0.2862523,0.2605937,0.2247351,0.2136279,0.1929169,
+     &0.1780802,0.1848382,0.2104575,0.2466988,0.3018862,
+     &0.3613543,0.4261933,0.4881637,0.5562663,0.6325883,
+     &0.6974163,0.7349945,0.7849246,0.8107314,0.8016415,
+     &0.7301529,0.6518985,0.5788133,0.5371399,0.5015947,
+     &0.4561899,0.4281780,0.4014403,0.3523277,0.3134494,
+     &0.2802024,0.2545224,0.2382317,0.2645295,0.2893848,
+     &0.3160831,0.3526863,0.3600670,0.3487748,0.3395592,
+     &0.3284123,0.3151843,0.2968681,0.2714744,0.2435622,
+     &0.2178014,0.1836341,0.1606565,0.1482674,0.1111388,
+     &0.0925535,0.0852699,0.0793584,0.0693137,0.0606733,
+     &0.0536815,0.0376899,0.0234903,0.0179599/
+       data omegicevis/
+     &0.9997557,0.9999997,0.9999922,0.9999319,0.9834057,
+     &0.9697400,0.9889413,0.4170863,0.3839164,0.4148017,
+     &0.4329225,0.4410049,0.4489707,0.4576899,0.4670268,
+     &0.4755634,0.4835813,0.4903115,0.4920676,0.4910262,
+     &0.4890484,0.4880903,0.4873634,0.4862187,0.4850952,
+     &0.4856144,0.4890416,0.4960548,0.5125623,0.5285751,
+     &0.5546114,0.5898761,0.6277213,0.6730058,0.7122949,
+     &0.7517495,0.7888858,0.8171780,0.8476295,0.8725174,
+     &0.8933310,0.9217324,0.9365012,0.9409229,0.9421082,
+     &0.9300490,0.9206304,0.9031980,0.8741305,0.8588691,
+     &0.8445156,0.8310569,0.8304268,0.8275097,0.8349118,
+     &0.8934678,0.9187520,0.9234176/
+       data omegiceir/
+     &0.9195789,0.9130654,0.9084498,0.8848193,0.8432430,
+     &0.7802753,0.7644560,0.7449288,0.7265303,0.7022048,
+     &0.6854911,0.6547806,0.6568891,0.6708937,0.6778638,
+     &0.6815536,0.6886025,0.6981948,0.7035849,0.7054032,
+     &0.7053613,0.6954878,0.6908569,0.6925153,0.6964372,
+     &0.6940646,0.6957520,0.7002053,0.6964250,0.6932367,
+     &0.6907555,0.6961634,0.7047681,0.7167735,0.7274370,
+     &0.7265938,0.7055041,0.6847062,0.6557705,0.6320110,
+     &0.6117497,0.5758710,0.5225218,0.4523725,0.3413817,
+     &0.2842636,0.2313632,0.1900614,0.1697527,0.1697629,
+     &0.1798291,0.1970501,0.2115807,0.2391071,0.2606377,
+     &0.2798113,0.2988472,0.3170983,0.3361139,0.3461500,
+     &0.3563966,0.3671677,0.3774159,0.3888194,0.4014468,
+     &0.4154617,0.4312829,0.4628420,0.4848666,0.4936416,
+     &0.4953880,0.4988511,0.4951004,0.4923347,0.5001683,
+     &0.5114973,0.5471412,0.5407871,0.5179877,0.5151565,
+     &0.5338754,0.5665359,0.5949027,0.6346611,0.6304472,
+     &0.6168448,0.5937971,0.5441191,0.5208242,0.4555555,
+     &0.2795748,0.1643928,0.0891554,0.0618627,0.0471263,
+     &0.0400198,0.0378990,0.0377831,0.0385226,0.0399469,
+     &0.0426608,0.0451856,0.0487382,0.0527340,0.0571690,
+     &0.0606253,0.0618599,0.0605589,0.0581096,0.0574950,
+     &0.0580301,0.0588644,0.0604849,0.0632511,0.0642014,
+     &0.0643580,0.0628783,0.0592713,0.0462856,0.0396805,
+     &0.0361116,0.0343350,0.0347561,0.0363269,0.0369600,
+     &0.0376791,0.0385242,0.0397799,0.0412408,0.0423222,
+     &0.0431063,0.0439387,0.0445039,0.0448168,0.0496150,
+     &0.0473067,0.0454896,0.0441976,0.0410999,0.0380139,
+     &0.0345402,0.0231292,0.0152373,0.0130964/
+       data gicevis/
+     &0.8343501,0.8539270,0.8165237,0.8181057,0.7824335,
+     &0.8121903,0.9116917,0.9469896,0.9339413,0.9264918,
+     &0.9194773,0.9152379,0.9105224,0.9045991,0.8973010,
+     &0.8895398,0.8811479,0.8731629,0.8704250,0.8714981,
+     &0.8741569,0.8753158,0.8759663,0.8770830,0.8782619,
+     &0.8777608,0.8743001,0.8669701,0.8513806,0.8396250,
+     &0.8215540,0.8018272,0.7843039,0.7655624,0.7525014,
+     &0.7398580,0.7289740,0.7259218,0.7254756,0.7268577,
+     &0.7324639,0.7521768,0.7661537,0.7739922,0.7902248,
+     &0.8065580,0.8156578,0.8255079,0.8347661,0.8373555,
+     &0.8387650,0.8389051,0.8371919,0.8368247,0.8344242,
+     &0.8242407,0.8213838,0.8203836/
+       data giceir/
+     &0.8202859,0.8204761,0.8207446,0.8218899,0.8224330,
+     &0.8225752,0.8226243,0.8228495,0.8228806,0.8232125,
+     &0.8228349,0.8170514,0.8134916,0.8073353,0.8051527,
+     &0.8032251,0.8010219,0.7986862,0.7967891,0.7952084,
+     &0.7923052,0.7898931,0.7867939,0.7811755,0.7750518,
+     &0.7710254,0.7664988,0.7615658,0.7570799,0.7523895,
+     &0.7475237,0.7419846,0.7361146,0.7300106,0.7239206,
+     &0.7182872,0.7132332,0.7041776,0.6943774,0.6874813,
+     &0.6799427,0.6676864,0.6541361,0.6444608,0.6352317,
+     &0.6299193,0.6244130,0.6191449,0.6140400,0.6095717,
+     &0.6048778,0.6003752,0.5971281,0.5896495,0.5818252,
+     &0.5736867,0.5649501,0.5561939,0.5469384,0.5418788,
+     &0.5367152,0.5314598,0.5255540,0.5191799,0.5126669,
+     &0.5058801,0.4979611,0.4805868,0.4616396,0.4517272,
+     &0.4414385,0.4213243,0.4114112,0.4014477,0.3914565,
+     &0.3809337,0.3465430,0.3234292,0.3130346,0.3027512,
+     &0.2918884,0.2798819,0.2676042,0.2318030,0.2231267,
+     &0.2135321,0.2026399,0.1847338,0.1781789,0.1631734,
+     &0.1323553,0.1103728,0.0936858,0.0867514,0.0807283,
+     &0.0744888,0.0694563,0.0645469,0.0595233,0.0546962,
+     &0.0524681,0.0503008,0.0483757,0.0475037,0.0475338,
+     &0.0483772,0.0487606,0.0480684,0.0460275,0.0444297,
+     &0.0429296,0.0423003,0.0418224,0.0413265,0.0403650,
+     &0.0392690,0.0380197,0.0367560,0.0344374,0.0328447,
+     &0.0317576,0.0306637,0.0305520,0.0300328,0.0293586,
+     &0.0289865,0.0286487,0.0283637,0.0280170,0.0273389,
+     &0.0265009,0.0250756,0.0239277,0.0232211,0.0215270,
+     &0.0195894,0.0185593,0.0177348,0.0161119,0.0145967,
+     &0.0131628,0.0091000,0.0058481,0.0047391/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.05
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.05	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.05	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 5 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=1.2E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=5.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0428143,2.0440466,2.1968415,2.2153285,2.2960923,
+     &2.3659375,2.8867066,1.4714612,1.7771624,1.8997087,
+     &1.9929919,2.0451753,2.0872736,2.1281450,2.1707144,
+     &2.2132783,2.2573934,2.3003073,2.3321264,2.3514304,
+     &2.3634045,2.3739398,2.3842189,2.3941483,2.4037600,
+     &2.4129043,2.4213498,2.4291728,2.4373298,2.4419029,
+     &2.4471161,2.4538815,2.4630349,2.4742622,2.4854822,
+     &2.5033839,2.5176528,2.5136092,2.5134516,2.5263309,
+     &2.5060482,2.6094491,2.6798794,2.6632533,2.7183650,
+     &2.8463554,2.9012349,2.9348140,2.9701750,2.9754398,
+     &2.9789634,2.9716895,2.9712498,2.9672985,2.9738250,
+     &3.0348940,3.1332080,3.1466768/
+       data epiceir/
+     &3.1348512,3.1135170,3.0980451,3.0516498,2.9460745,
+     &2.7977514,2.7647121,2.7296543,2.6980081,2.6652355,
+     &2.6520360,2.6446781,2.6661332,2.7014117,2.7124405,
+     &2.7181728,2.7285180,2.7372139,2.7347012,2.7262812,
+     &2.7032161,2.6736920,2.6591630,2.6453030,2.6226292,
+     &2.5987844,2.5791478,2.5533869,2.5169418,2.4857807,
+     &2.4605293,2.4401815,2.4123871,2.3720129,2.3076501,
+     &2.2154198,2.1208081,1.9929006,1.8554076,1.7655714,
+     &1.6732348,1.5088136,1.2957467,1.1248519,1.0043060,
+     &0.9623911,0.9399940,0.9638529,1.0305194,1.1452191,
+     &1.2687433,1.4178077,1.5291764,1.7348669,1.8864686,
+     &2.0165479,2.1304126,2.2267041,2.3057120,2.3408694,
+     &2.3737895,2.3992765,2.4196458,2.4389904,2.4559703,
+     &2.4664493,2.4680557,2.4285460,2.3429909,2.2869768,
+     &2.2235444,2.0965919,2.0351093,1.9889221,1.9465162,
+     &1.8934352,1.6640973,1.4980435,1.4440260,1.4054043,
+     &1.3498148,1.2628263,1.1601040,0.8777069,0.8140609,
+     &0.7497768,0.6831331,0.5837339,0.5504547,0.4820068,
+     &0.3904156,0.3576854,0.3641066,0.4038780,0.4747776,
+     &0.5532535,0.6412786,0.7272216,0.8227299,0.9304959,
+     &1.0245264,1.0890912,1.1736258,1.2312673,1.2493920,
+     &1.1830822,1.0889487,0.9851518,0.9227560,0.8740039,
+     &0.8118621,0.7720758,0.7351863,0.6589684,0.5922329,
+     &0.5316939,0.4811391,0.4445072,0.4707272,0.5020384,
+     &0.5401840,0.5982011,0.6122363,0.6017624,0.5915391,
+     &0.5768967,0.5586212,0.5319895,0.4920566,0.4455049,
+     &0.4009319,0.3399382,0.2980777,0.2753274,0.2093637,
+     &0.1716706,0.1567566,0.1449283,0.1247388,0.1076142,
+     &0.0937344,0.0625980,0.0375503,0.0283737/
+       data omegicevis/
+     &0.5494931,0.9999998,0.9999893,0.9999013,0.9758908,
+     &0.9520350,0.9813806,0.4902175,0.4373621,0.4608643,
+     &0.4736899,0.4790656,0.4847680,0.4913164,0.4985126,
+     &0.5050762,0.5111622,0.5159741,0.5158814,0.5132105,
+     &0.5098287,0.5077458,0.5059724,0.5035798,0.5004508,
+     &0.4974112,0.4955608,0.4956980,0.4999822,0.5055479,
+     &0.5182787,0.5389499,0.5644807,0.6003360,0.6358722,
+     &0.6744935,0.7115463,0.7406379,0.7754455,0.8046825,
+     &0.8330303,0.8720050,0.8909805,0.8971584,0.8986517,
+     &0.8775966,0.8676537,0.8459433,0.8139567,0.7968134,
+     &0.7813268,0.7666911,0.7660663,0.7625950,0.7705110,
+     &0.8471078,0.8871527,0.8974949/
+       data omegiceir/
+     &0.8977836,0.8945748,0.8924134,0.8738061,0.8388449,
+     &0.7859417,0.7726671,0.7557423,0.7397608,0.7176195,
+     &0.7014517,0.6706539,0.6709267,0.6829631,0.6896477,
+     &0.6933964,0.7002523,0.7101147,0.7166997,0.7200235,
+     &0.7232453,0.7166191,0.7139632,0.7179898,0.7246478,
+     &0.7245268,0.7280882,0.7347864,0.7340991,0.7336202,
+     &0.7333983,0.7403341,0.7504411,0.7639143,0.7766036,
+     &0.7794099,0.7640404,0.7500795,0.7291497,0.7110402,
+     &0.6959369,0.6683127,0.6242461,0.5602421,0.4472759,
+     &0.3841803,0.3222430,0.2709396,0.2443090,0.2429399,
+     &0.2540719,0.2731242,0.2887707,0.3170114,0.3380532,
+     &0.3559635,0.3733418,0.3897057,0.4070157,0.4162955,
+     &0.4258323,0.4362862,0.4465349,0.4581154,0.4711562,
+     &0.4861186,0.5037051,0.5414228,0.5708696,0.5832593,
+     &0.5885317,0.5983726,0.5977412,0.5976148,0.6077798,
+     &0.6216503,0.6655161,0.6657503,0.6467597,0.6461229,
+     &0.6660358,0.6987826,0.7269489,0.7691699,0.7678677,
+     &0.7591690,0.7429094,0.7052954,0.6864988,0.6300915,
+     &0.4480666,0.2989470,0.1806929,0.1314649,0.1033070,
+     &0.0896708,0.0859415,0.0864679,0.0888946,0.0928023,
+     &0.0989119,0.1047399,0.1125751,0.1210458,0.1301845,
+     &0.1373109,0.1401302,0.1382077,0.1341803,0.1336529,
+     &0.1354927,0.1375671,0.1411836,0.1473035,0.1498776,
+     &0.1508872,0.1485618,0.1416996,0.1143930,0.0999223,
+     &0.0919109,0.0879268,0.0889088,0.0927174,0.0943725,
+     &0.0961518,0.0982119,0.1012073,0.1047162,0.1074747,
+     &0.1096113,0.1120945,0.1138527,0.1148487,0.1264241,
+     &0.1220450,0.1182757,0.1155932,0.1089078,0.1020501,
+     &0.0940495,0.0660757,0.0452682,0.0393932/
+       data gicevis/
+     &0.9488561,0.8622694,0.8421568,0.8444307,0.8198477,
+     &0.8025251,0.8924177,0.9702666,0.9557836,0.9476732,
+     &0.9401344,0.9356233,0.9306720,0.9244909,0.9168691,
+     &0.9087364,0.8999177,0.8914922,0.8885176,0.8896047,
+     &0.8924723,0.8939612,0.8951342,0.8972442,0.9004632,
+     &0.9036172,0.9051868,0.9042581,0.8988889,0.8931115,
+     &0.8817939,0.8662245,0.8491337,0.8268852,0.8078062,
+     &0.7890281,0.7693759,0.7548954,0.7426000,0.7296526,
+     &0.7270693,0.7355062,0.7289565,0.7364469,0.7544447,
+     &0.7692665,0.7925164,0.8065700,0.8307455,0.8377706,
+     &0.8427537,0.8454301,0.8436610,0.8436959,0.8396172,
+     &0.8239458,0.8273445,0.8320904/
+       data giceir/
+     &0.8373514,0.8419112,0.8460672,0.8574966,0.8670993,
+     &0.8753594,0.8769836,0.8787410,0.8801410,0.8817471,
+     &0.8821138,0.8790489,0.8760744,0.8707907,0.8689077,
+     &0.8674014,0.8654746,0.8634583,0.8622014,0.8614331,
+     &0.8604119,0.8602243,0.8590601,0.8563642,0.8534315,
+     &0.8516557,0.8491830,0.8464145,0.8443506,0.8419912,
+     &0.8393673,0.8359801,0.8324290,0.8288801,0.8258969,
+     &0.8241146,0.8232231,0.8199658,0.8160087,0.8130227,
+     &0.8095026,0.8040639,0.7986902,0.7954774,0.7927923,
+     &0.7908941,0.7887109,0.7863154,0.7833571,0.7799240,
+     &0.7757225,0.7708758,0.7671629,0.7589634,0.7514880,
+     &0.7439123,0.7363079,0.7288431,0.7213242,0.7172369,
+     &0.7129840,0.7087308,0.7039406,0.6985872,0.6929027,
+     &0.6868637,0.6798444,0.6653367,0.6513552,0.6442967,
+     &0.6372020,0.6223192,0.6148563,0.6068394,0.5979654,
+     &0.5884917,0.5583712,0.5388037,0.5299017,0.5197192,
+     &0.5079988,0.4946542,0.4810905,0.4402598,0.4297767,
+     &0.4177190,0.4033195,0.3778822,0.3680294,0.3443614,
+     &0.2904477,0.2472555,0.2122748,0.1975763,0.1849724,
+     &0.1717572,0.1611385,0.1505969,0.1396510,0.1290195,
+     &0.1242519,0.1192575,0.1148210,0.1125826,0.1120808,
+     &0.1130957,0.1133712,0.1114241,0.1063793,0.1023448,
+     &0.0985022,0.0968736,0.0956093,0.0943082,0.0919330,
+     &0.0892278,0.0861601,0.0830894,0.0777779,0.0741764,
+     &0.0717541,0.0693096,0.0690498,0.0677189,0.0660590,
+     &0.0651242,0.0642725,0.0635431,0.0626790,0.0610575,
+     &0.0590792,0.0557436,0.0530752,0.0514414,0.0475330,
+     &0.0431135,0.0407930,0.0389434,0.0353244,0.0319652,
+     &0.0288019,0.0198931,0.0127889,0.0103672/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.10
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.10	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aerice.h.10	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 10 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=0.8E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-5,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0273049,2.0553651,2.1324184,2.1634929,2.1279089,
+     &2.2649884,2.2698500,2.0945108,1.9718964,2.0290234,
+     &2.0724838,2.0969706,2.1164510,2.1352997,2.1550443,
+     &2.1750197,2.1959615,2.2164886,2.2313924,2.2397768,
+     &2.2443697,2.2484777,2.2524328,2.2560196,2.2593305,
+     &2.2624981,2.2655437,2.2686977,2.2731700,2.2766244,
+     &2.2794294,2.2792618,2.2795415,2.2846086,2.2950807,
+     &2.3121541,2.3191226,2.3011398,2.2936110,2.2905064,
+     &2.2727025,2.3178666,2.3242922,2.3330655,2.3261759,
+     &2.3501878,2.3524554,2.3359809,2.3611195,2.3675768,
+     &2.3733923,2.3748493,2.3755083,2.3754752,2.3756132,
+     &2.3760719,2.4271755,2.3955469/
+       data epiceir/
+     &2.4612815,2.4641292,2.4568148,2.5147929,2.5530331,
+     &2.5705762,2.5728459,2.5721469,2.5704122,2.5617049,
+     &2.5519185,2.5355358,2.5353646,2.5456607,2.5519402,
+     &2.5570130,2.5640745,2.5747874,2.5854921,2.5940452,
+     &2.6071377,2.6118498,2.6188061,2.6403730,2.6669781,
+     &2.6775784,2.6885033,2.7046711,2.7192614,2.7353652,
+     &2.7494493,2.7692459,2.7941475,2.8259096,2.8570986,
+     &2.8766527,2.8766177,2.8746240,2.8368504,2.7997968,
+     &2.7614427,2.6663651,2.4818733,2.2510304,1.9602349,
+     &1.8146522,1.6854036,1.6102730,1.6048870,1.6705624,
+     &1.7576077,1.8667697,1.9497169,2.0947831,2.2019422,
+     &2.2885010,2.3667836,2.4332867,2.4948113,2.5246017,
+     &2.5532246,2.5817444,2.6085849,2.6368368,2.6661391,
+     &2.6972022,2.7322018,2.8090558,2.8837960,2.9189849,
+     &2.9399867,2.9627054,2.9581554,2.9556482,2.9702957,
+     &2.9914343,3.0622592,3.0227430,2.9683504,2.9483757,
+     &2.9425662,2.9222951,2.8775811,2.6872020,2.5973134,
+     &2.4775703,2.3277271,2.0808144,1.9930708,1.7932411,
+     &1.3749977,1.1105362,0.9519616,0.9414314,1.0029964,
+     &1.0884044,1.1978686,1.3110209,1.4375935,1.5781999,
+     &1.7028408,1.8087940,1.9384904,2.0478878,2.1342847,
+     &2.1552835,2.1219630,2.0431452,1.9908499,1.9683007,
+     &1.9452211,1.9265127,1.9173379,1.8556699,1.7696880,
+     &1.6679885,1.5544487,1.4389187,1.3726599,1.3709559,
+     &1.4067492,1.4992472,1.5341307,1.5684799,1.5883886,
+     &1.5933384,1.5931257,1.5828085,1.5444956,1.4816657,
+     &1.4080117,1.2855885,1.1866654,1.1282085,0.9652229,
+     &0.7942671,0.7229686,0.6674553,0.5672902,0.4800995,
+     &0.4058672,0.2359050,0.1220444,0.0873671/
+       data omegicevis/
+     &0.5504259,0.9999992,0.9999804,0.9997928,0.9548051,
+     &0.9126351,0.9571041,0.5516225,0.4932337,0.5069626,
+     &0.5145947,0.5177403,0.5216092,0.5264726,0.5321194,
+     &0.5374104,0.5423936,0.5462285,0.5453517,0.5420842,
+     &0.5383082,0.5359790,0.5340598,0.5316239,0.5284724,
+     &0.5251024,0.5221875,0.5200486,0.5182305,0.5173715,
+     &0.5181928,0.5213331,0.5280793,0.5438614,0.5659477,
+     &0.5936272,0.6220001,0.6461561,0.6788177,0.7087492,
+     &0.7393658,0.7893919,0.8146747,0.8209112,0.8149179,
+     &0.7802355,0.7582701,0.7185146,0.6685008,0.6464375,
+     &0.6278486,0.6119440,0.6113081,0.6078985,0.6163179,
+     &0.7056757,0.7598560,0.7761379/
+       data omegiceir/
+     &0.7759839,0.7669778,0.7639439,0.7364159,0.6928631,
+     &0.6428539,0.6326926,0.6199911,0.6088360,0.5931817,
+     &0.5812727,0.5587846,0.5566773,0.5620723,0.5661795,
+     &0.5687336,0.5732306,0.5805613,0.5866805,0.5907671,
+     &0.5969589,0.5957459,0.5962836,0.6028957,0.6124275,
+     &0.6156567,0.6218417,0.6321118,0.6370467,0.6411974,
+     &0.6447079,0.6546141,0.6691408,0.6888857,0.7109522,
+     &0.7267580,0.7246028,0.7274987,0.7256792,0.7211279,
+     &0.7193315,0.7149989,0.7013977,0.6651995,0.5782154,
+     &0.5228451,0.4628350,0.4070674,0.3747672,0.3693838,
+     &0.3776684,0.3927504,0.4044872,0.4236842,0.4359979,
+     &0.4452721,0.4529338,0.4591291,0.4647588,0.4675789,
+     &0.4704044,0.4736306,0.4769657,0.4809483,0.4857694,
+     &0.4920136,0.5005317,0.5248833,0.5530189,0.5680709,
+     &0.5790995,0.6006733,0.6076213,0.6135495,0.6271621,
+     &0.6453611,0.7096416,0.7277915,0.7180390,0.7214272,
+     &0.7430624,0.7781302,0.8105813,0.8638036,0.8667906,
+     &0.8650255,0.8590664,0.8432143,0.8341830,0.8032821,
+     &0.6736456,0.5327421,0.3821245,0.3023261,0.2506925,
+     &0.2248830,0.2181999,0.2206931,0.2274191,0.2371715,
+     &0.2492834,0.2612511,0.2759819,0.2907880,0.3061035,
+     &0.3189336,0.3259392,0.3269015,0.3248960,0.3278614,
+     &0.3352942,0.3411323,0.3492400,0.3630564,0.3716860,
+     &0.3780700,0.3789840,0.3714330,0.3232819,0.2950966,
+     &0.2783259,0.2697008,0.2717506,0.2816038,0.2868812,
+     &0.2919132,0.2975354,0.3052135,0.3144514,0.3230745,
+     &0.3308428,0.3415695,0.3497911,0.3546669,0.3859474,
+     &0.3858507,0.3821296,0.3797063,0.3712473,0.3611613,
+     &0.3470088,0.2835475,0.2232076,0.2036654/
+       data gicevis/
+     &0.9488313,0.8737755,0.8699134,0.8632549,0.8664746,
+     &0.8654723,0.8639066,0.9867598,0.9718844,0.9635127,
+     &0.9558461,0.9512742,0.9462659,0.9400148,0.9322755,
+     &0.9239700,0.9149156,0.9062143,0.9031032,0.9042205,
+     &0.9072103,0.9088409,0.9101745,0.9125225,0.9162391,
+     &0.9205437,0.9242871,0.9270018,0.9297845,0.9314710,
+     &0.9314710,0.9295564,0.9256747,0.9176448,0.9091137,
+     &0.8993065,0.8857244,0.8742417,0.8625565,0.8491372,
+     &0.8415641,0.8312504,0.8189208,0.8167353,0.8238611,
+     &0.8239230,0.8371644,0.8417686,0.8616024,0.8695507,
+     &0.8752736,0.8796579,0.8782625,0.8792304,0.8746206,
+     &0.8405395,0.8161123,0.8190467/
+       data giceir/
+     &0.8215228,0.8188539,0.8235543,0.8430634,0.8634555,
+     &0.8889333,0.8943647,0.9004826,0.9057037,0.9118157,
+     &0.9151983,0.9186423,0.9165455,0.9109817,0.9085578,
+     &0.9069400,0.9043546,0.9010347,0.8988791,0.8976911,
+     &0.8963661,0.8980653,0.8983047,0.8966079,0.8940747,
+     &0.8933308,0.8913805,0.8891829,0.8896720,0.8898105,
+     &0.8894080,0.8870043,0.8841559,0.8807722,0.8783676,
+     &0.8806533,0.8874398,0.8930346,0.8980618,0.9013399,
+     &0.9038298,0.9075544,0.9122803,0.9171227,0.9216645,
+     &0.9230088,0.9236676,0.9233609,0.9217389,0.9185820,
+     &0.9143328,0.9086544,0.9041949,0.8948452,0.8875402,
+     &0.8805291,0.8743904,0.8689287,0.8643938,0.8621209,
+     &0.8597336,0.8575692,0.8550812,0.8520836,0.8486272,
+     &0.8446994,0.8398250,0.8288277,0.8186790,0.8140771,
+     &0.8110483,0.8041257,0.8015433,0.7980613,0.7919027,
+     &0.7852415,0.7688640,0.7656652,0.7660689,0.7611709,
+     &0.7521669,0.7417981,0.7344227,0.7222472,0.7201254,
+     &0.7173442,0.7131014,0.7038283,0.6999976,0.6905708,
+     &0.6637480,0.6310949,0.5964675,0.5787684,0.5612767,
+     &0.5405343,0.5222011,0.5027949,0.4812989,0.4589987,
+     &0.4483198,0.4369166,0.4259420,0.4192472,0.4154068,
+     &0.4142449,0.4130682,0.4088767,0.3968293,0.3857591,
+     &0.3742922,0.3692816,0.3648685,0.3617240,0.3566430,
+     &0.3508260,0.3437443,0.3361050,0.3206013,0.3090643,
+     &0.3008432,0.2916748,0.2902482,0.2839455,0.2766951,
+     &0.2723766,0.2683532,0.2648085,0.2613389,0.2555560,
+     &0.2486358,0.2367881,0.2269753,0.2207384,0.2052476,
+     &0.1863302,0.1759822,0.1676274,0.1511226,0.1356524,
+     &0.1210628,0.0811427,0.0511400,0.0412876/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeropacity.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeropacity.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeropacity.F	(revision 46)
@@ -0,0 +1,520 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &    tauref,tau,aerosol,reffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+      real r0,reff,coefsize
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+c **********************************************************
+c    Declaration special local dust storm TASI   
+         logical localstorm
+         real taulocref,ztoploc,radloc,lonloc,latloc
+         integer ltoploc
+         real tauloc ! diagnostic only
+c **********************************************************
+
+
+
+
+
+      call zerophys(ngrid*naerkind,tau)
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          tracername=noms(iq)
+          IF (tracername(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        call zerophys(nlayer*naerkind,msolsir)
+        call zerophys(nlayer*naerkind,mqextsqabs)
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c  -------------------------------------------------------------
+c     1) Prescribed dust  (if tracer=F or active=F)
+c  -------------------------------------------------------------
+      IF ((.not.tracer) .or. (.not.active)) THEN 
+
+c       Vertical column optical depth at 700.Pa 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        IF(iaervar.eq.1) THEN 
+           do ig=1, ngridmx
+            tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                         ! or read in starfi
+          end do
+        ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+          tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+           taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+           tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+           tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+           do ig=1,ngrid/2  ! Northern hemisphere
+             tauref(ig)= tauN +
+     &       (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+           end do
+           do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+             tauref(ig)= tauS +
+     &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+           end do
+
+        ELSE IF ((iaervar.eq.4).or.
+     &           ((iaervar.ge.24).and.(iaervar.le.26)).or.
+     &           (iaervar.eq.6).or.(iaervar.eq.7))
+     &       THEN  ! << "TES assimilated dust scenarios >>
+           call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+        ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+          tauref(1) = 2.5
+          if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+        ELSE
+          stop 'problem with iaervar in aeropacity.F'
+        ENDIF
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          !! Lilia : standart 1; 0.8; 1.2
+            topdust(ig)=1.0*topdust(ig)
+          !!
+          end do
+        endif
+
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+          expfactor=0.
+          CALL zerophys(ngrid,taudusttmp)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+c             Scaling factor
+              taudusttmp(ig)=taudusttmp(ig)+aerosol(ig,l,iaer)
+            ENDDO
+          ENDDO
+
+c         Rescaling each layer to reproduce the choosen (or
+c           assimilated) dust extinction opacity at visible
+c           reference wavelength, which is originally scaled
+c           to an equivalent 700Pa pressure surface.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              aerosol(ig,l,iaer) = tauref(ig) *
+     &                     pplev(ig,1) / 700.E0 *
+     &                     aerosol(ig,l,iaer) / taudusttmp(ig)
+            ENDDO
+          ENDDO
+
+c ***************************************************************
+c    SPECIAL LOCAL DUST STORM TASI
+c    We modify only aerosol calculated above where the local dust storm is 
+
+      localstorm =  .true.
+      if (localstorm) then
+         taulocref = 2 !10  ! ref optical depth of the local dust storm
+         ztoploc = 11    ! target pseudo-altitude of local storm (km)
+         radloc = 4.     ! radius of dust storm (degree)
+         lonloc=-3       ! center longitude of storm (deg)
+         latloc=-2.      ! center latitude of storm (deg)
+
+         DO ig=1,ngrid
+c          Where is the dust storm:
+           if (((lati(ig)*180./pi-latloc)**2 
+     &       + (long(ig)*180./pi -lonloc)**2).le.(radloc**2))then
+c             Computing where is the top level of the localstorm
+              DO l=nlayer,1,-1
+                ltoploc=l+1
+                if(-10*log(pplev(ig,l)/pplev(ig,1)).lt.ztoploc)goto 88
+              END DO
+ 88           continue
+              DO l=1,ltoploc-1
+                 aerosol(ig,l,1)=max(aerosol(ig,l,1),
+     &                  taulocref* (pplev(ig,l)-pplev(ig,l+1))
+     &                 /(pplev(ig,1)-pplev(ig,ltoploc)))
+              END DO
+
+c             diagnostic
+              write(*,*)
+              write(*,*) 'lat,lon',lati(ig)*180./pi,long(ig)*180./pi 
+              write(*,*) 'true dustorm top pseudo-height (km) = ',
+     &          -10*log(pplev(ig,ltoploc)/pplev(ig,1))
+c             tauloc=0.
+c             DO l=1,nlayer
+c              tauloc = tauloc + aerosol(ig,l,1)
+c              write(*,*) 'below ',
+c    &          -10*log(pplev(ig,l+1)/pplev(ig,1)),
+c    &         'km, tau=', tauloc 
+c             ENDDO
+
+           endif
+         END DO
+      endif
+c ***************************************************************
+
+
+
+          CALL zerophys(ngrid,taudustvis)
+          CALL zerophys(ngrid,taudusttes)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              taudustvis(ig) = taudustvis(ig) + aerosol(ig,l,iaer)
+              taudusttes(ig) = taudusttes(ig) + aerosol(ig,l,iaer)*
+     &          QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer)*
+     &          ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+            ENDDO
+          ENDDO
+
+c         Outputs
+          IF (ngrid.NE.1) THEN
+!            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
+!     &        ' ',2,taudusttes)
+            if (callstats) then
+              CALL wstats(ngridmx,'taudustTES','dust abs IR',
+     &          ' ',2,taudusttes)
+            endif
+          ELSE
+            CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
+          ENDIF
+
+c     changement dans le calcul de la distribution verticale          
+c     dans le cas des scenarios de poussieres assimiles
+c        if (iaervar.eq.4) THEN  ! TES
+c        call zerophys(ngrid*naerkind,tau)
+c
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+c           end do
+c        end do
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+c     $     *(pplev(ig,1)/700)
+c           end do
+c        end do
+c        endif
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c  ---------------------------------------------------------------------
+c     2) Transported radiatively active dust  (if tracer=T and active=T)
+c ----------------------------------------------------------------------
+      ELSE  IF ((tracer) .and. (active)) THEN 
+c     The dust opacity is computed from q
+
+c     a) "doubleq" technique (transport of mass and number mixing ratio)
+c        ~~~~~~~~~~~~~~~~~~~
+       if(doubleq) then 
+
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+
+c        Computing effective radius :
+         do  l=1,nlayer
+           do ig=1, ngrid
+              r0=
+     &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+              r0=min(max(r0,1.e-10),500.e-6)
+              reff= ref_r0 * r0
+cc           If  reff is small, the transported dust mean Qext
+c            is reduced from the reference dust Qext by a factor "coefsize"
+
+             coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+
+cc              It is added 1.e-8 to pq to avoid low
+
+                aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+     &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+     &          * (pq(ig,l,nqdust(1)))*
+c               only one dust bin to use with doubleq
+     &          (pplev(ig,l)-pplev(ig,l+1))/g
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+
+c     b) Size bin technique (each aerosol can contribute to opacity))
+c        ~~~~~~~~~~~~~~~~~~
+       else
+c        The dust opacity is computed from q
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         do iq=1,dustbin
+           do l=1,nlayer
+              do ig=1,ngrid
+cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+cc               It is added 1.e-8 to pq to avoid low
+                 aerosol(ig,l,1)=aerosol(ig,l,1)+
+     &           qextrhor(nqdust(iq))*(pq(ig,l,nqdust(iq))+1.e-8)*
+     &           (pplev(ig,l)-pplev(ig,l+1))/g
+              end do
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+       end if  ! (doubleq)
+      END IF   ! (dust scenario)
+
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+
+      IF (water.AND.activice) THEN
+c       1. Initialization
+        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))
+        CALL zerophys(ngrid,taucloudvis)
+        CALL zerophys(ngrid,taucloudtes)
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) =
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        ( pq(ig,l,i_ice) + 1.E-8 ) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+!          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+!     &      ' ',2,taucloudtes)
+!          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+!     &      ' ',2,taucloudtes)
+        ELSE
+          CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+      ENDIF
+
+c==================================================================
+        END SELECT aerkind
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+
+      do l=1,nlayer
+         do ig=1,ngrid
+               tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+         end do
+      end do
+
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeroptproperties.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeroptproperties.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/aeroptproperties.F	(revision 46)
@@ -0,0 +1,1121 @@
+      SUBROUTINE aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                            QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                            QIRsQREF3d,omegaIR3d,gIR3d,
+     &                            QREFvis3d,QREFir3d,
+     &                            omegaREFvis3d,omegaREFir3d)
+      IMPLICIT NONE
+c     =============================================================
+c     Aerosol Optical Properties
+c
+c     Description:
+c       Compute the scattering parameters in each grid
+c       box, depending on aerosol grain sizes. Log-normal size
+c       distribution and Gauss-Legendre integration are used.
+
+c     Parameters:
+c       Don't forget to set the value of varyingnueff below; If
+c       the effective variance of the distribution for the given
+c       aerosol is considered homogeneous in the atmosphere, please
+c       set varyingnueff(iaer) to .false. Resulting computational
+c       time will be much better.
+
+c     Authors: J.-B. Madeleine, F. Forget, F. Montmessin
+c     =============================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+
+c     Local variables 
+c     ---------------
+
+c     =============================================================
+      LOGICAL, PARAMETER :: varyingnueff(naerkind) = .false.
+c     =============================================================
+
+c     Min. and max radius of the interpolation grid (in METERS)
+      REAL, PARAMETER :: refftabmin = 5e-8 !2e-8
+      REAL, PARAMETER :: refftabmax = 35e-6
+c     Log of the min and max variance of the interpolation grid
+      REAL, PARAMETER :: nuefftabmin = -4.6
+      REAL, PARAMETER :: nuefftabmax = 0.
+c     Number of effective radius of the interpolation grid
+      INTEGER, PARAMETER :: refftabsize = 100
+c     Number of effective variances of the interpolation grid
+      INTEGER, PARAMETER :: nuefftabsize = 100
+c     Interpolation grid indices (reff,nueff)
+      INTEGER :: grid_i,grid_j
+c     Intermediate variable
+      REAL :: var_tmp,var3d_tmp(ngridmx,nlayermx)
+c     Bilinear interpolation factors
+      REAL :: kx,ky,k1,k2,k3,k4
+c     Size distribution parameters
+      REAL :: sizedistk1,sizedistk2
+c     Pi!
+      REAL,SAVE :: pi
+c     Variables used by the Gauss-Legendre integration:
+      INTEGER radius_id,gausind
+      REAL kint
+      REAL drad
+      REAL weightgaus(5),radgaus(5)
+      SAVE weightgaus,radgaus
+      DATA weightgaus/.2955242247,.2692667193,.2190863625,
+     &                .1494513491,.0666713443/
+      DATA radgaus/.1488743389,.4333953941,.6794095682,
+     &             .8650633666,.9739065285/
+
+c     Indices
+      INTEGER :: i,j,k,l,m,iaer,idomain
+      INTEGER :: ig,lg,chg
+
+c     Local saved variables
+c     ---------------------
+
+c     Radius axis of the interpolation grid
+      REAL,SAVE :: refftab(refftabsize)
+c     Variance axis of the interpolation grid
+      REAL,SAVE :: nuefftab(nuefftabsize)
+c     Volume ratio of the grid
+      REAL,SAVE :: logvratgrid,vratgrid
+c     Grid used to remember which calculation is done
+      LOGICAL,SAVE :: checkgrid(refftabsize,nuefftabsize,naerkind,2)
+     &                = .false.
+c     Optical properties of the grid (VISIBLE)
+      REAL,SAVE :: qsqrefVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: qextVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: qscatVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: omegVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: gVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+c     Optical properties of the grid (INFRARED)
+      REAL,SAVE :: qsqrefIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: qextIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: qscatIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: omegIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: gIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+c     Optical properties of the grid (REFERENCE WAVELENGTHS)
+      REAL,SAVE :: qrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefIRgrid(refftabsize,nuefftabsize,naerkind)
+c     Firstcall
+      LOGICAL,SAVE :: firstcall = .true.
+c     Variables used by the Gauss-Legendre integration:
+      REAL,SAVE :: normd(refftabsize,nuefftabsize,naerkind,2)
+      REAL,SAVE :: dista(refftabsize,nuefftabsize,naerkind,2,5)
+      REAL,SAVE :: distb(refftabsize,nuefftabsize,naerkind,2,5)
+
+      REAL,SAVE :: radGAUSa(5,naerkind,2)
+      REAL,SAVE :: radGAUSb(5,naerkind,2)
+
+      REAL,SAVE :: qsqrefVISa(nsun,5,naerkind)
+      REAL,SAVE :: qrefVISa(5,naerkind)
+      REAL,SAVE :: qsqrefVISb(nsun,5,naerkind)
+      REAL,SAVE :: qrefVISb(5,naerkind)
+      REAL,SAVE :: omegVISa(nsun,5,naerkind)
+      REAL,SAVE :: omegrefVISa(5,naerkind)
+      REAL,SAVE :: omegVISb(nsun,5,naerkind)
+      REAL,SAVE :: omegrefVISb(5,naerkind)
+      REAL,SAVE :: gVISa(nsun,5,naerkind)
+      REAL,SAVE :: gVISb(nsun,5,naerkind)
+
+      REAL,SAVE :: qsqrefIRa(nir,5,naerkind)
+      REAL,SAVE :: qrefIRa(5,naerkind)
+      REAL,SAVE :: qsqrefIRb(nir,5,naerkind)
+      REAL,SAVE :: qrefIRb(5,naerkind)
+      REAL,SAVE :: omegIRa(nir,5,naerkind)
+      REAL,SAVE :: omegrefIRa(5,naerkind)
+      REAL,SAVE :: omegIRb(nir,5,naerkind)
+      REAL,SAVE :: omegrefIRb(5,naerkind)
+      REAL,SAVE :: gIRa(nir,5,naerkind)
+      REAL,SAVE :: gIRb(nir,5,naerkind)
+
+      REAL :: radiusm
+      REAL :: radiusr
+
+c     Inputs
+c     ------
+
+      INTEGER :: ngrid,nlayer
+c     Aerosol effective radius used for radiative transfer (meter)
+      REAL :: reffrad(ngridmx,nlayermx,naerkind)
+c     Aerosol effective variance used for radiative transfer (n.u.)
+      REAL :: nueffrad(ngridmx,nlayermx,naerkind)
+
+c     Outputs
+c     -------
+
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+        IF ( (nsize(iaer,1).EQ.1).AND.(nsize(iaer,2).EQ.1) ) THEN
+c==================================================================
+c       If there is one single particle size, optical
+c         properties of the considered aerosol are homogeneous
+          DO lg = 1, nlayer
+            DO ig = 1, ngrid
+              DO chg = 1, nsun
+                QVISsQREF3d(ig,lg,chg,iaer)=QVISsQREF(chg,iaer,1)
+                omegaVIS3d(ig,lg,chg,iaer)=omegaVIS(chg,iaer,1)
+                gVIS3d(ig,lg,chg,iaer)=gVIS(chg,iaer,1)
+              ENDDO
+              DO chg = 1, nir
+                QIRsQREF3d(ig,lg,chg,iaer)=QIRsQREF(chg,iaer,1)
+                omegaIR3d(ig,lg,chg,iaer)=omegaIR(chg,iaer,1)
+                gIR3d(ig,lg,chg,iaer)=gIR(chg,iaer,1)
+              ENDDO
+              QREFvis3d(ig,lg,iaer)=QREFvis(iaer,1)
+              QREFir3d(ig,lg,iaer)=QREFir(iaer,1)
+              omegaREFvis3d(ig,lg,iaer)=omegaREFvis(iaer,1)
+              omegaREFir3d(ig,lg,iaer)=omegaREFir(iaer,1)
+            ENDDO
+          ENDDO
+        ELSE ! Varying effective radius and variance
+      DO idomain = 1, 2 ! Loop on visible or infrared channel
+c==================================================================
+c     1. Creating the effective radius and variance grid
+c     --------------------------------------------------
+      IF (firstcall) THEN
+
+c       1.1 Pi!
+        pi = 2. * asin(1.e0)
+
+c       1.2 Effective radius
+        refftab(1)    = refftabmin
+        refftab(refftabsize) = refftabmax
+
+        logvratgrid = log(refftabmax/refftabmin) /
+     &                float(refftabsize-1)*3.
+        vratgrid = exp(logvratgrid)
+
+        do i = 2, refftabsize-1
+          refftab(i) = refftab(i-1)*vratgrid**(1./3.)
+        enddo
+
+c       1.3 Effective variance
+        do i = 0, nuefftabsize-1
+          nuefftab(i+1) = exp( nuefftabmin +
+     &             i*(nuefftabmax-nuefftabmin)/(nuefftabsize-1) )
+        enddo
+        firstcall = .false.
+      ENDIF
+
+c       1.4 Radius middle point and range for Gauss integration
+        radiusm=
+     &         0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) +
+     &              radiustab(iaer,idomain,1))
+        radiusr=
+     &         0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) -
+     &              radiustab(iaer,idomain,1))
+
+c       1.5 Interpolating data at the Gauss quadrature points:
+        DO gausind=1,5
+          drad=radiusr*radgaus(gausind)
+          radGAUSa(gausind,iaer,idomain)=radiusm-drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) -
+     &                         (radiusm-drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) - 
+     &         (radiusm-drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+          kint = ( (radiusm-drad) - 
+     &             radiustab(iaer,idomain,radius_id) ) /
+     &           ( radiustab(iaer,idomain,radius_id+1) - 
+     &             radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,nsun
+            qsqrefVISa(m,gausind,iaer)=
+     &              (1-kint)*QVISsQREF(m,iaer,radius_id) + 
+     &              kint*QVISsQREF(m,iaer,radius_id+1)
+            omegVISa(m,gausind,iaer)=
+     &              (1-kint)*omegaVIS(m,iaer,radius_id) + 
+     &              kint*omegaVIS(m,iaer,radius_id+1)
+            gVISa(m,gausind,iaer)=
+     &              (1-kint)*gVIS(m,iaer,radius_id) + 
+     &              kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISa(gausind,iaer)=
+     &              (1-kint)*QREFvis(iaer,radius_id) + 
+     &              kint*QREFvis(iaer,radius_id+1)
+            omegrefVISa(gausind,iaer)=
+     &              (1-kint)*omegaREFvis(iaer,radius_id) + 
+     &              kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,nir
+            qsqrefIRa(m,gausind,iaer)=
+     &              (1-kint)*QIRsQREF(m,iaer,radius_id) + 
+     &              kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRa(m,gausind,iaer)=
+     &              (1-kint)*omegaIR(m,iaer,radius_id) + 
+     &              kint*omegaIR(m,iaer,radius_id+1)
+            gIRa(m,gausind,iaer)=
+     &              (1-kint)*gIR(m,iaer,radius_id) + 
+     &              kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRa(gausind,iaer)=
+     &              (1-kint)*QREFir(iaer,radius_id) + 
+     &              kint*QREFir(iaer,radius_id+1)
+            omegrefIRa(gausind,iaer)=
+     &              (1-kint)*omegaREFir(iaer,radius_id) + 
+     &              kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+
+        DO gausind=1,5
+          drad=radiusr*radgaus(gausind)
+          radGAUSb(gausind,iaer,idomain)=radiusm+drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) - 
+     &                         (radiusm+drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) - 
+     &         (radiusm+drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+            kint = ( (radiusm+drad) -
+     &               radiustab(iaer,idomain,radius_id) ) /
+     &             ( radiustab(iaer,idomain,radius_id+1) - 
+     &               radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,nsun
+            qsqrefVISb(m,gausind,iaer)=
+     &              (1-kint)*QVISsQREF(m,iaer,radius_id) + 
+     &              kint*QVISsQREF(m,iaer,radius_id+1)
+            omegVISb(m,gausind,iaer)=
+     &              (1-kint)*omegaVIS(m,iaer,radius_id) + 
+     &              kint*omegaVIS(m,iaer,radius_id+1)
+            gVISb(m,gausind,iaer)=
+     &              (1-kint)*gVIS(m,iaer,radius_id) + 
+     &              kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISb(gausind,iaer)=
+     &              (1-kint)*QREFvis(iaer,radius_id) + 
+     &              kint*QREFvis(iaer,radius_id+1)
+            omegrefVISb(gausind,iaer)=
+     &              (1-kint)*omegaREFvis(iaer,radius_id) + 
+     &              kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,nir
+            qsqrefIRb(m,gausind,iaer)=
+     &              (1-kint)*QIRsQREF(m,iaer,radius_id) + 
+     &              kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRb(m,gausind,iaer)=
+     &              (1-kint)*omegaIR(m,iaer,radius_id) + 
+     &              kint*omegaIR(m,iaer,radius_id+1)
+            gIRb(m,gausind,iaer)=
+     &              (1-kint)*gIR(m,iaer,radius_id) + 
+     &              kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRb(gausind,iaer)=
+     &              (1-kint)*QREFir(iaer,radius_id) + 
+     &              kint*QREFir(iaer,radius_id+1)
+            omegrefIRb(gausind,iaer)=
+     &              (1-kint)*omegaREFir(iaer,radius_id) + 
+     &              kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+c==================================================================
+      IF ( .NOT.varyingnueff(iaer) ) THEN          ! CONSTANT NUEFF
+c==================================================================
+c     2. Compute the scattering parameters using linear
+c       interpolation over grain sizes and constant nueff
+c     ---------------------------------------------------
+
+      DO lg = 1,nlayer
+        DO ig = 1,ngrid
+c         2.1 Effective radius index and kx calculation
+          var_tmp=reffrad(ig,lg,iaer)/refftabmin
+          var_tmp=log(var_tmp)*3.
+          var_tmp=var_tmp/logvratgrid+1.
+          grid_i=floor(var_tmp)
+          IF (grid_i.GE.refftabsize) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger grain sizes.'
+            grid_i=refftabsize-1
+            kx = 1.
+          ELSEIF (grid_i.LT.1) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller grain sizes.'
+            grid_i=1
+            kx = 0.
+          ELSE
+            kx = ( reffrad(ig,lg,iaer)-refftab(grid_i) ) /
+     &           ( refftab(grid_i+1)-refftab(grid_i) )
+          ENDIF
+c         2.3 Integration
+          DO j=grid_i,grid_i+1
+c             2.3.1 Check if the calculation has been done
+              IF (.NOT.checkgrid(j,1,iaer,idomain)) THEN
+c               2.3.2 Log-normal dist., r_g and sigma_g are defined
+c                 in [hansen_1974], "Light scattering in planetary
+c                 atmospheres", Space Science Reviews 16 527-610.
+c                 Here, sizedistk1=r_g and sizedistk2=sigma_g^2
+                sizedistk2 = log(1.+nueffrad(1,1,iaer))
+                sizedistk1 = exp(2.5*sizedistk2)
+                sizedistk1 = refftab(j) / sizedistk1
+
+                normd(j,1,iaer,idomain) = 1e-30
+                DO gausind=1,5
+                  drad=radiusr*radgaus(gausind)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              LOG((radiusm-drad)/sizedistk1)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              EXP(-dista(j,1,iaer,idomain,gausind) * 
+     &              dista(j,1,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm-drad)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              dista(j,1,iaer,idomain,gausind) / 
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              LOG((radiusm+drad)/sizedistk1)
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              EXP(-distb(j,1,iaer,idomain,gausind) * 
+     &              distb(j,1,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm+drad)
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              distb(j,1,iaer,idomain,gausind) / 
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  normd(j,1,iaer,idomain)=normd(j,1,iaer,idomain) +
+     &              weightgaus(gausind) *
+     &              (
+     &              distb(j,1,iaer,idomain,gausind) * pi * 
+     &              radGAUSb(gausind,iaer,idomain) * 
+     &              radGAUSb(gausind,iaer,idomain) +
+     &              dista(j,1,iaer,idomain,gausind) * pi * 
+     &              radGAUSa(gausind,iaer,idomain) * 
+     &              radGAUSa(gausind,iaer,idomain)
+     &              )
+                ENDDO
+                IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------
+c                 2.3.3.vis Initialization
+                  qsqrefVISgrid(j,1,:,iaer)=0.
+                  qextVISgrid(j,1,:,iaer)=0.
+                  qscatVISgrid(j,1,:,iaer)=0.
+                  omegVISgrid(j,1,:,iaer)=0.
+                  gVISgrid(j,1,:,iaer)=0.
+                  qrefVISgrid(j,1,iaer)=0.
+                  qscatrefVISgrid(j,1,iaer)=0.
+                  omegrefVISgrid(j,1,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nsun
+c                     Convolution:
+                      qextVISgrid(j,1,m,iaer) = 
+     &                  qextVISgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefVISb(m,gausind,iaer) * 
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) * 
+     &                  radGAUSb(gausind,iaer,idomain) * 
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  qsqrefVISa(m,gausind,iaer) * 
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) * 
+     &                  radGAUSa(gausind,iaer,idomain) * 
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      qscatVISgrid(j,1,m,iaer) = 
+     &                  qscatVISgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      gVISgrid(j,1,m,iaer) =
+     &                  gVISgrid(j,1,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gVISb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gVISa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefVISgrid(j,1,iaer) = 
+     &                qrefVISgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                    qscatrefVISgrid(j,1,iaer) = 
+     &                qscatrefVISgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefVISb(gausind,iaer) *
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                omegrefVISa(gausind,iaer) *
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+
+                  qrefVISgrid(j,1,iaer)=qrefVISgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  qscatrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  omegrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /
+     &                         qrefVISgrid(j,1,iaer)
+                  DO m=1,nsun
+                    qextVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    qscatVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    gVISgrid(j,1,m,iaer)=gVISgrid(j,1,m,iaer) / 
+     &                          qscatVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+
+                    qsqrefVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /
+     &                          qrefVISgrid(j,1,iaer)
+                    omegVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) / 
+     &                          qextVISgrid(j,1,m,iaer)
+                  ENDDO
+                ELSE                   ! INFRARED DOMAIN ----------
+c                 2.3.3.ir Initialization
+                  qsqrefIRgrid(j,1,:,iaer)=0.
+                  qextIRgrid(j,1,:,iaer)=0.
+                  qscatIRgrid(j,1,:,iaer)=0.
+                  omegIRgrid(j,1,:,iaer)=0.
+                  gIRgrid(j,1,:,iaer)=0.
+                  qrefIRgrid(j,1,iaer)=0.
+                  qscatrefIRgrid(j,1,iaer)=0.
+                  omegrefIRgrid(j,1,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nir
+c                     Convolution:
+                      qextIRgrid(j,1,m,iaer) = 
+     &                  qextIRgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefIRb(m,gausind,iaer) * 
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) * 
+     &                  radGAUSb(gausind,iaer,idomain) * 
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  qsqrefIRa(m,gausind,iaer) * 
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) * 
+     &                  radGAUSa(gausind,iaer,idomain) * 
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      qscatIRgrid(j,1,m,iaer) = 
+     &                  qscatIRgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      gIRgrid(j,1,m,iaer) =
+     &                  gIRgrid(j,1,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gIRb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gIRa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefIRgrid(j,1,iaer) = 
+     &                qrefIRgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                    qscatrefIRgrid(j,1,iaer) = 
+     &                qscatrefIRgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefIRb(gausind,iaer) *
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                omegrefIRa(gausind,iaer) *
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+
+                  qrefIRgrid(j,1,iaer)=qrefIRgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  qscatrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  omegrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /
+     &                         qrefIRgrid(j,1,iaer)
+                  DO m=1,nir
+                    qextIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    qscatIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    gIRgrid(j,1,m,iaer)=gIRgrid(j,1,m,iaer) / 
+     &                          qscatIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+
+                    qsqrefIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /
+     &                          qrefVISgrid(j,1,iaer)
+                    omegIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) / 
+     &                          qextIRgrid(j,1,m,iaer)
+                  ENDDO
+                ENDIF                  ! --------------------------
+                checkgrid(j,1,iaer,idomain) = .true.
+              ENDIF !checkgrid
+          ENDDO !grid_i
+c         2.4 Linear interpolation
+          k1 = (1-kx)
+          k2 = kx
+          IF (idomain.EQ.1) THEN ! VISIBLE ------------------------
+          DO m=1,nsun
+            QVISsQREF3d(ig,lg,m,iaer) =
+     &                  k1*qsqrefVISgrid(grid_i,1,m,iaer) +
+     &                  k2*qsqrefVISgrid(grid_i+1,1,m,iaer)
+            omegaVIS3d(ig,lg,m,iaer) =
+     &                  k1*omegVISgrid(grid_i,1,m,iaer) +
+     &                  k2*omegVISgrid(grid_i+1,1,m,iaer)
+            gVIS3d(ig,lg,m,iaer) =
+     &                  k1*gVISgrid(grid_i,1,m,iaer) +
+     &                  k2*gVISgrid(grid_i+1,1,m,iaer)
+          ENDDO !nsun
+          QREFvis3d(ig,lg,iaer) =
+     &                  k1*qrefVISgrid(grid_i,1,iaer) +
+     &                  k2*qrefVISgrid(grid_i+1,1,iaer)
+          omegaREFvis3d(ig,lg,iaer) =
+     &                  k1*omegrefVISgrid(grid_i,1,iaer) +
+     &                  k2*omegrefVISgrid(grid_i+1,1,iaer)
+          ELSE                   ! INFRARED -----------------------
+          DO m=1,nir
+            QIRsQREF3d(ig,lg,m,iaer) =
+     &                  k1*qsqrefIRgrid(grid_i,1,m,iaer) +
+     &                  k2*qsqrefIRgrid(grid_i+1,1,m,iaer)
+            omegaIR3d(ig,lg,m,iaer) =
+     &                  k1*omegIRgrid(grid_i,1,m,iaer) +
+     &                  k2*omegIRgrid(grid_i+1,1,m,iaer)
+            gIR3d(ig,lg,m,iaer) =
+     &                  k1*gIRgrid(grid_i,1,m,iaer) +
+     &                  k2*gIRgrid(grid_i+1,1,m,iaer)
+          ENDDO !nir
+          QREFir3d(ig,lg,iaer) =
+     &                  k1*qrefIRgrid(grid_i,1,iaer) +
+     &                  k2*qrefIRgrid(grid_i+1,1,iaer)
+          omegaREFir3d(ig,lg,iaer) =
+     &                  k1*omegrefIRgrid(grid_i,1,iaer) +
+     &                  k2*omegrefIRgrid(grid_i+1,1,iaer)
+          ENDIF                  ! --------------------------------
+        ENDDO !nlayermx
+      ENDDO !ngridmx
+c==================================================================
+      ELSE                                          ! VARYING NUEFF
+c==================================================================
+c     3. Compute the scattering parameters in each grid box
+c       using bilinear interpolation over the grain sizes
+c       and the effective variances;
+c     -----------------------------------------------------
+
+      DO lg = 1,nlayer
+        DO ig = 1,ngrid
+c         3.1 Effective variance index and ky calculation
+          var_tmp=log(nueffrad(ig,lg,iaer))
+          grid_j=floor( (nuefftabsize-1)/(nuefftabmax-nuefftabmin)*
+     &       (var_tmp-nuefftabmin)+1. )
+          IF (grid_j.GE.nuefftabsize) THEN
+c           WRITE(*,*) 'Warning: effective variance '
+c           WRITE(*,*) 'is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger values.'
+            grid_j=nuefftabsize-1
+            ky = 1.
+          ELSEIF (grid_j.LT.1) THEN
+c           WRITE(*,*) 'Warning: effective variance '
+c           WRITE(*,*) 'is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller values.'
+            grid_j=1
+            ky = 0.
+          ELSE
+            ky = ( nueffrad(ig,lg,iaer)-nuefftab(grid_j) ) /
+     &           ( nuefftab(grid_j+1)-nuefftab(grid_j) )
+          ENDIF
+c         3.2 Effective radius index and kx calculation
+          var_tmp=reffrad(ig,lg,iaer)/refftabmin
+          var_tmp=log(var_tmp)*3.
+          var_tmp=var_tmp/logvratgrid+1.
+          grid_i=floor(var_tmp)
+          IF (grid_i.GE.refftabsize) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger grain sizes.'
+            grid_i=refftabsize-1
+            kx = 1.
+          ELSEIF (grid_i.LT.1) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller grain sizes.'
+            grid_i=1
+            kx = 0.
+          ELSE
+            kx = ( reffrad(ig,lg,iaer)-refftab(grid_i) ) /
+     &           ( refftab(grid_i+1)-refftab(grid_i) )
+          ENDIF
+c         3.3 Integration
+          DO j=grid_i,grid_i+1
+            DO k=grid_j,grid_j+1
+c             3.3.1 Check if the calculation has been done
+              IF (.NOT.checkgrid(j,k,iaer,idomain)) THEN
+
+c               3.3.2 Log-normal dist., r_g and sigma_g are defined
+c                 in [hansen_1974], "Light scattering in planetary
+c                 atmospheres", Space Science Reviews 16 527-610.
+c                 Here, sizedistk1=r_g and sizedistk2=sigma_g^2
+                sizedistk2 = log(1.+nuefftab(k))
+                sizedistk1 = exp(2.5*sizedistk2)
+                sizedistk1 = refftab(j) / sizedistk1
+
+                normd(j,k,iaer,idomain) = 1e-30
+                DO gausind=1,5
+                  drad=radiusr*radgaus(gausind)
+
+                  dista(j,k,iaer,idomain,gausind) =
+     &              LOG((radiusm-drad)/sizedistk1)
+                  dista(j,k,iaer,idomain,gausind) =
+     &              EXP(-dista(j,k,iaer,idomain,gausind) *
+     &              dista(j,k,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm-drad)
+                  dista(j,k,iaer,idomain,gausind) =
+     &              dista(j,k,iaer,idomain,gausind) /
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  distb(j,k,iaer,idomain,gausind) =
+     &              LOG((radiusm+drad)/sizedistk1)
+                  distb(j,k,iaer,idomain,gausind) =
+     &              EXP(-distb(j,k,iaer,idomain,gausind) *
+     &              distb(j,k,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm+drad)
+                  distb(j,k,iaer,idomain,gausind) =
+     &              distb(j,k,iaer,idomain,gausind) /
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  normd(j,k,iaer,idomain)=normd(j,k,iaer,idomain) +
+     &              weightgaus(gausind) *
+     &              (
+     &              distb(j,k,iaer,idomain,gausind) * pi *
+     &              radGAUSb(gausind,iaer,idomain) *
+     &              radGAUSb(gausind,iaer,idomain) +
+     &              dista(j,k,iaer,idomain,gausind) * pi *
+     &              radGAUSa(gausind,iaer,idomain) *
+     &              radGAUSa(gausind,iaer,idomain)
+     &              )
+                ENDDO
+                IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------
+c                 2.3.3.vis Initialization
+                  qsqrefVISgrid(j,k,:,iaer)=0.
+                  qextVISgrid(j,k,:,iaer)=0.
+                  qscatVISgrid(j,k,:,iaer)=0.
+                  omegVISgrid(j,k,:,iaer)=0.
+                  gVISgrid(j,k,:,iaer)=0.
+                  qrefVISgrid(j,k,iaer)=0.
+                  qscatrefVISgrid(j,k,iaer)=0.
+                  omegrefVISgrid(j,k,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nsun
+c                     Convolution:
+                      qextVISgrid(j,k,m,iaer) =
+     &                  qextVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      qscatVISgrid(j,k,m,iaer) =
+     &                  qscatVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      gVISgrid(j,k,m,iaer) =
+     &                  gVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gVISb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gVISa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefVISgrid(j,k,iaer) =
+     &                qrefVISgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                    qscatrefVISgrid(j,k,iaer) =
+     &                qscatrefVISgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefVISb(gausind,iaer) *
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                omegrefVISa(gausind,iaer) *
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+                  qrefVISgrid(j,k,iaer)=qrefVISgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  qscatrefVISgrid(j,k,iaer)=qscatrefVISgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  omegrefVISgrid(j,k,iaer)=qscatrefVISgrid(j,k,iaer) /
+     &                         qrefVISgrid(j,k,iaer)
+                  DO m=1,nsun
+                    qextVISgrid(j,k,m,iaer)=qextVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    qscatVISgrid(j,k,m,iaer)=qscatVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    gVISgrid(j,k,m,iaer)=gVISgrid(j,k,m,iaer) /
+     &                          qscatVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+
+                    qsqrefVISgrid(j,k,m,iaer)=qextVISgrid(j,k,m,iaer) /
+     &                          qrefVISgrid(j,k,iaer)
+                    omegVISgrid(j,k,m,iaer)=qscatVISgrid(j,k,m,iaer) /
+     &                          qextVISgrid(j,k,m,iaer)
+                  ENDDO
+                ELSE                   ! INFRARED DOMAIN ----------
+c                 2.3.3.ir Initialization
+                  qsqrefIRgrid(j,k,:,iaer)=0.
+                  qextIRgrid(j,k,:,iaer)=0.
+                  qscatIRgrid(j,k,:,iaer)=0.
+                  omegIRgrid(j,k,:,iaer)=0.
+                  gIRgrid(j,k,:,iaer)=0.
+                  qrefIRgrid(j,k,iaer)=0.
+                  qscatrefIRgrid(j,k,iaer)=0.
+                  omegrefIRgrid(j,k,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nir
+c                     Convolution:
+                      qextIRgrid(j,k,m,iaer) =
+     &                  qextIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      qscatIRgrid(j,k,m,iaer) =
+     &                  qscatIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      gIRgrid(j,k,m,iaer) =
+     &                  gIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gIRb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gIRa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefIRgrid(j,k,iaer) =
+     &                qrefIRgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                    qscatrefIRgrid(j,k,iaer) =
+     &                qscatrefIRgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefIRb(gausind,iaer) *
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                omegrefIRa(gausind,iaer) *
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+                  qrefIRgrid(j,k,iaer)=qrefIRgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  qscatrefIRgrid(j,k,iaer)=qscatrefIRgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  omegrefIRgrid(j,k,iaer)=qscatrefIRgrid(j,k,iaer) /
+     &                         qrefIRgrid(j,k,iaer)
+                  DO m=1,nir
+                    qextIRgrid(j,k,m,iaer)=qextIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    qscatIRgrid(j,k,m,iaer)=qscatIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    gIRgrid(j,k,m,iaer)=gIRgrid(j,k,m,iaer) /
+     &                          qscatIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+
+                    qsqrefIRgrid(j,k,m,iaer)=qextIRgrid(j,k,m,iaer) /
+     &                          qrefVISgrid(j,k,iaer)
+                    omegIRgrid(j,k,m,iaer)=qscatIRgrid(j,k,m,iaer) /
+     &                          qextIRgrid(j,k,m,iaer)
+                  ENDDO
+                ENDIF                  ! --------------------------
+                checkgrid(j,k,iaer,idomain) = .true.
+              ENDIF !checkgrid
+            ENDDO !grid_j
+          ENDDO !grid_i
+c         3.4 Bilinear interpolation
+          k1 = (1-kx)*(1-ky)
+          k2 = kx*(1-ky)
+          k3 = kx*ky
+          k4 = (1-kx)*ky
+          IF (idomain.EQ.1) THEN ! VISIBLE ------------------------
+          DO m=1,nsun
+            QVISsQREF3d(ig,lg,m,iaer) = 
+     &                  k1*qsqrefVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*qsqrefVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*qsqrefVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*qsqrefVISgrid(grid_i,grid_j+1,m,iaer)
+            omegaVIS3d(ig,lg,m,iaer) = 
+     &                  k1*omegVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*omegVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*omegVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*omegVISgrid(grid_i,grid_j+1,m,iaer)
+            gVIS3d(ig,lg,m,iaer) = 
+     &                  k1*gVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*gVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*gVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*gVISgrid(grid_i,grid_j+1,m,iaer)
+          ENDDO !nsun
+          QREFvis3d(ig,lg,iaer) = 
+     &                  k1*qrefVISgrid(grid_i,grid_j,iaer) +
+     &                  k2*qrefVISgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*qrefVISgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*qrefVISgrid(grid_i,grid_j+1,iaer)
+          omegaREFvis3d(ig,lg,iaer) = 
+     &                  k1*omegrefVISgrid(grid_i,grid_j,iaer) +
+     &                  k2*omegrefVISgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*omegrefVISgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*omegrefVISgrid(grid_i,grid_j+1,iaer)
+          ELSE                   ! INFRARED -----------------------
+          DO m=1,nir
+            QIRsQREF3d(ig,lg,m,iaer) = 
+     &                  k1*qsqrefIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*qsqrefIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*qsqrefIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*qsqrefIRgrid(grid_i,grid_j+1,m,iaer)
+            omegaIR3d(ig,lg,m,iaer) = 
+     &                  k1*omegIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*omegIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*omegIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*omegIRgrid(grid_i,grid_j+1,m,iaer)
+            gIR3d(ig,lg,m,iaer) =
+     &                  k1*gIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*gIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*gIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*gIRgrid(grid_i,grid_j+1,m,iaer)
+          ENDDO !nir
+          QREFir3d(ig,lg,iaer) =
+     &                  k1*qrefIRgrid(grid_i,grid_j,iaer) +
+     &                  k2*qrefIRgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*qrefIRgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*qrefIRgrid(grid_i,grid_j+1,iaer)
+          omegaREFir3d(ig,lg,iaer) =
+     &                  k1*omegrefIRgrid(grid_i,grid_j,iaer) +
+     &                  k2*omegrefIRgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*omegrefIRgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*omegrefIRgrid(grid_i,grid_j+1,iaer)
+          ENDIF                  ! --------------------------------
+        ENDDO !nlayermx
+      ENDDO !ngridmx
+
+      ENDIF ! varyingnueff
+c==================================================================
+      ENDDO ! idomain
+
+      ENDIF ! nsize = 1
+
+      ENDDO ! iaer (loop on aerosol kind)
+
+      RETURN
+      END
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/albedocaps.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/albedocaps.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/albedocaps.F90	(revision 46)
@@ -0,0 +1,375 @@
+subroutine albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
+
+! routine which changes the albedo (and emissivity) of the surface
+! depending on the presence of CO2 ice on the surface
+
+! to use the 'getin' routine 
+use ioipsl_getincom 
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"surfdat.h"
+
+! arguments:
+real,intent(in) :: zls ! solar longitude (rad)
+integer,intent(in) :: ngrid
+real,intent(in) :: piceco2(ngrid) ! amount of CO2 ice on the surface (kg/m2)
+real,intent(out) :: psolaralb(ngrid,2) ! albedo of the surface
+real,intent(out) :: emisref(ngrid) ! emissivity of the surface
+
+
+! local variables:
+logical,save :: firstcall=.true.
+integer :: ig,icap
+
+! 1. Initializations
+if (firstcall) then
+  ! find out if user wants to use TES cap albedoes or not
+  TESicealbedo=.false. ! default value 
+  write(*,*)" albedocaps: Use TES Cap albedoes ?"
+  call getin("TESicealbedo",TESicealbedo)
+  write(*,*)" albedocaps: TESicealbedo = ",TESicealbedo
+  
+  ! if using TES albedoes, load coeffcients
+  if (TESicealbedo) then
+    write(*,*)" albedocaps: Coefficient for Northern Cap ?"
+    TESice_Ncoef=1.0 ! default value
+    call getin("TESice_Ncoef",TESice_Ncoef)
+    write(*,*)" albedocaps: TESice_Ncoef = ",TESice_Ncoef
+    
+    write(*,*)" albedocaps: Coefficient for Southern Cap ?"
+    TESice_Scoef=1.0 ! default value
+    call getin("TESice_Scoef",TESice_Scoef)
+    write(*,*)" albedocaps: TESice_Scoef = ",TESice_Scoef
+  endif
+  
+  firstcall=.false.
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+  if (ig.gt.ngrid/2+1) then
+    icap=2 ! Southern hemisphere
+  else
+    icap=1 ! Northern hemisphere
+  endif
+
+  if (piceco2(ig).gt.0) then
+    ! set emissivity of surface to be the ice emissivity
+    emisref(ig)=emisice(icap)
+    ! set the surface albedo to be the ice albedo
+    if (TESicealbedo) then
+!      write(*,*) "albedocaps: call TES_icecap_albedo"
+!      write(*,*) "albedocaps: zls=",zls," ig=",ig
+      call TES_icecap_albedo(zls,ig,psolaralb(ig,1))
+!      write(*,*) "albedocaps: psolaralb(ig,1)=",psolaralb(ig,1)
+      psolaralb(ig,2)=psolaralb(ig,1)
+    else
+      psolaralb(ig,1)=albedice(icap)
+      psolaralb(ig,2)=albedice(icap)
+    endif
+  else
+    ! set emissivity of surface to be bare ground emissivity
+    emisref(ig)=emissiv
+    ! set the surface albedo to bare ground albedo 
+    psolaralb(ig,1)=albedodat(ig)
+    psolaralb(ig,2)=albedodat(ig)
+  endif ! of if (piceco2(ig).gt.0)
+enddo ! of ig=1,ngrid
+
+end subroutine albedocaps
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine TES_icecap_albedo(zls,ig,alb)
+
+implicit none
+#include"dimensions.h"
+#include"dimphys.h"
+#include"surfdat.h"
+#include"comgeomfi.h"
+#include"netcdf.inc"
+#include"datafile.h"
+
+! arguments:
+real,intent(in) :: zls ! solar longitude (rad)
+integer,intent(in) :: ig ! grid point index
+real,intent(out) :: alb ! (interpolated) TES ice albedo at that grid point
+
+! local variables:
+logical,save :: firstcall=.true.
+real,save :: zls_old ! value of zls from a previous call
+integer,save :: tinf,tsup ! encompassing time indexes of TES data
+real,save :: reltime ! relative position in-between time indexes (in [0;1])
+integer :: latinf,latsup ! encompassing latitude indexes of TES data
+real :: rellat ! relative position in-between latitude indexes (in[0;1])
+integer :: loninf,lonsup ! encompassing longitude indexes of TES data
+real :: rellon !relative position in-between longitude indexes (in[0;1])
+real,save :: pi,radeg ! to convert radians to degrees
+real :: zlsd ! solar longitude, in degrees
+real :: latd ! latitude, in degrees
+real :: lond ! longitude, in degrees
+integer :: i
+integer :: icap ! =1: Northern hemisphere =2: Southern hemisphere
+
+! TES datasets: (hard coded fixed length/sizes; for now)
+integer,parameter :: TESlonsize=72
+real,parameter :: TESdeltalon=5.0 ! step in longitude in TES files
+! longitudes, in TES files, in degrees, from TESlon(1)=-177.5 to TESlon(72)=177.5
+real,save :: TESlon(TESlonsize) 
+integer,parameter :: TESlatsize=30
+real,parameter :: TESdeltalat=2.0 ! step in latitude in TES files
+! latitudes (north hemisphere file), in degrees, from TESlatn(1)=31,
+! to TESlatn(30)=89 ; TESlatn(8)=45
+real,parameter :: TESlatnmin=45. ! minimum TES latitude (North hemisphere)
+real,parameter :: TESlatsmax=-45. ! maximum TES latitude (South hemisphere)
+real,save :: TESlatn(TESlatsize)
+! latitudes (south hemisphere file), in degrees, from TESlats(1)=-89,
+! to TESlats(30)=-31 ; TESlats(23)=-45
+real,save :: TESlats(TESlatsize)
+integer,parameter :: TESlssize=72
+real,parameter :: TESdeltals=5.0 ! step in solar longitude in TES files
+! Solar longitude in TES files, TESls(1)=2.5 to TESls(72)=357.5
+real,save :: TESls(TESlssize)
+! TES North albedo (=-1 for missing values)
+real,save :: TESalbn(TESlonsize,TESlatsize,TESlssize)
+! TES South albedo (=-1 for missing values)
+real,save :: TESalbs(TESlonsize,TESlatsize,TESlssize)
+! encompassing nodes arranged as follow : 4 3
+real :: val(4)                          ! 1 2 
+
+!NetCDF variables:
+integer :: ierr ! NetCDF status
+integer :: nid ! NetCDF file ID
+integer :: nvarid ! NetCDF variable ID
+
+! 0. Preliminary stuff
+if (firstcall) then
+! Load TES albedoes for Northern Hemisphere
+  ! Note: datafile() is defined in "datafile.h"
+  ierr=NF_OPEN(trim(datafile)//"/npsc_albedo.nc",NF_NOWRITE,nid)
+  IF (ierr.NE.NF_NOERR) THEN
+    write(*,*)'Problem opening npsc_albedo.nc (phymars/albedocaps.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, npsc_albedo.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_VARID(nid,"longitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find longitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlon)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"latitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find latitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlatn)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"time",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find time in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESls)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find albedo in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbn)
+  endif
+
+! Load albedoes for Southern Hemisphere
+  ierr=NF_OPEN(trim(datafile)//"/spsc_albedo.nc",NF_NOWRITE,nid)
+  IF (ierr.NE.NF_NOERR) THEN
+    write(*,*)'Problem opening spsc_albedo.nc (phymars/albedocaps.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, spsc_albedo.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_VARID(nid,"latitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find latitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlats)
+  endif
+
+  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find albedo in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbs)
+  endif
+
+! constants:
+  pi=acos(-1.)
+  radeg=180/pi
+
+  zls_old=-999 ! dummy initialization
+
+  firstcall=.false.
+endif ! of if firstcall
+
+! 1. Identify hemisphere and encompassing latitudes
+if (ig.GT.ngridmx/2+1) then
+  icap=2 ! Southern hemisphere
+else
+  icap=1 ! Northern hemisphere
+endif
+
+! Check that latitude is such that there is TES data to use
+! (ie: latitude 45 deg and poleward) otherwise use 'default' albedoes
+latd=lati(ig)*radeg ! latitude, in degrees
+if (icap.eq.1) then
+ ! North hemisphere
+ if (latd.lt.TESlatnmin) then
+   alb=albedice(1)
+   ! the job is done; quit this routine
+   return
+ else
+   ! find encompassing latitudes
+   if (latd.ge.TESlatn(TESlatsize)) then
+     latinf=TESlatsize
+     latsup=TESlatsize
+     rellat=0.
+   else
+     do i=1,TESlatsize-1
+       if ((latd.ge.TESlatn(i)).and.(latd.lt.TESlatn(i+1))) then
+         latinf=i
+         latsup=i+1
+         rellat=(latd-TESlatn(i))/TESdeltalat
+         exit ! found encompassing indexes; quit loop
+       endif
+     enddo
+   endif
+ endif ! of if (latd.lt.TESlatnmin)
+else ! icap=2
+ ! South hemisphere
+ if (latd.gt.TESlatsmax) then
+   alb=albedice(2)
+   ! the job is done; quit this routine
+   return
+ else
+   ! find encompassing latitudes
+   if (latd.lt.TESlats(1)) then
+     latinf=1
+     latsup=1
+     rellat=0.
+   else
+     do i=1,TESlatsize-1
+       if ((latd.ge.TESlats(i)).and.(latd.lt.TESlats(i+1))) then
+         latinf=i
+         latsup=i+1
+         rellat=(latd-TESlats(i))/TESdeltalat
+         exit ! found encompassing indexes; quit loop
+       endif
+     enddo
+   endif
+ endif ! of if (latd.gt.-45.)
+endif ! of if (icap.eq.1)
+
+! 2. Identify encompassing time indexes
+if (zls.ne.zls_old) then
+  zlsd=zls*radeg ! solar longitude, in degrees
+  
+  if (zlsd.lt.TESls(1)) then
+    tinf=TESlssize
+    tsup=1
+    reltime=0.5+zlsd/TESdeltals
+  else
+    if (zlsd.ge.TESls(TESlssize)) then
+      tinf=TESlssize
+      tsup=1
+      reltime=(360.-zlsd)/TESdeltals
+    else
+      ! look for encompassing indexes
+      do i=1,TESlssize-1
+        if ((zlsd.ge.TESls(i)).and.(zlsd.lt.TESls(i+1))) then
+          tinf=i
+          tsup=i+1
+          reltime=(zlsd-TESls(i))/TESdeltals
+          exit ! quit loop, we found the indexes
+        endif
+      enddo
+    endif
+  endif ! of if (zlsd.lt.TESls(1))
+  
+  zls_old=zls ! store current zls
+endif ! of if (zls.ne.zls_old)
+
+! 3. Identify encompassing longitudes
+lond=long(ig)*radeg ! east longitude, in degrees
+if (lond.lt.TESlon(1)) then
+  loninf=TESlonsize
+  lonsup=1
+  rellon=0.5+(180.+lond)/TESdeltalon
+else
+  if (lond.ge.TESlon(TESlonsize)) then
+    loninf=TESlonsize
+    lonsup=1
+    rellon=(180-lond)/TESdeltalon
+  else
+    do i=1,TESlonsize-1
+      if ((lond.ge.TESlon(i)).and.(lond.lt.TESlon(i+1))) then
+        loninf=i
+        lonsup=i+1
+        rellon=(lond-TESlon(i))/TESdeltalon
+        exit ! quit loop, we found the indexes
+      endif
+    enddo
+  endif ! of if (lond.ge.TESlon(TESlonsize))
+endif ! of if (lond.lt.TESlon(1))
+
+! 4. Use linear interpolation in time to build encompassing nodal values
+!    encompassing nodes are arranged as follow : 4 3
+!                                                1 2
+if (icap.eq.1) then
+  ! Northern hemisphere
+  val(1)=(1.-reltime)*TESalbn(loninf,latinf,tinf) &
+         +reltime*TESalbn(loninf,latinf,tsup)
+  val(2)=(1.-reltime)*TESalbn(lonsup,latinf,tinf) &
+         +reltime*TESalbn(lonsup,latinf,tsup)
+  val(3)=(1.-reltime)*TESalbn(lonsup,latsup,tinf) &
+         +reltime*TESalbn(lonsup,latsup,tsup)
+  val(4)=(1.-reltime)*TESalbn(loninf,latsup,tinf) &
+         +reltime*TESalbn(loninf,latsup,tsup)
+else
+  ! Southern hemisphere
+  val(1)=(1.-reltime)*TESalbs(loninf,latinf,tinf) &
+         +reltime*TESalbs(loninf,latinf,tsup)
+  val(2)=(1.-reltime)*TESalbs(lonsup,latinf,tinf) &
+         +reltime*TESalbs(lonsup,latinf,tsup)
+  val(3)=(1.-reltime)*TESalbs(lonsup,latsup,tinf) &
+         +reltime*TESalbs(lonsup,latsup,tsup)
+  val(4)=(1.-reltime)*TESalbs(loninf,latsup,tinf) &
+         +reltime*TESalbs(loninf,latsup,tsup)
+endif ! of if (icap.eq.1)
+
+! 5. Use bilinear interpolation to compute albedo
+alb=(1.-rellon)*(1.-rellat)*val(1) &
+    +rellon*(1.-rellat)*val(2) &
+    +rellon*rellat*val(3) &
+    +(1.-rellon)*rellat*val(4)
+
+! 6. Apply coefficient to interpolated TES albedo
+if (icap.eq.1) then
+  alb=alb*TESice_Ncoef
+else
+  alb=alb*TESice_Scoef
+endif ! of if (icap.eq.1)
+
+end subroutine TES_icecap_albedo
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_aeropacity.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_aeropacity.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_aeropacity.F	(revision 46)
@@ -0,0 +1,464 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &    tauref,tau,aerosol,reffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+      real r0,reff,coefsize
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+      call zerophys(ngrid*naerkind,tau)
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          tracername=noms(iq)
+          IF (tracername(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        call zerophys(nlayer*naerkind,msolsir)
+        call zerophys(nlayer*naerkind,mqextsqabs)
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c  -------------------------------------------------------------
+c     1) Prescribed dust  (if tracer=F or active=F)
+c  -------------------------------------------------------------
+      IF ((.not.tracer) .or. (.not.active)) THEN 
+
+c       Vertical column optical depth at 700.Pa 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        IF(iaervar.eq.1) THEN 
+           do ig=1, ngridmx
+            tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                         ! or read in starfi
+          end do
+        ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+          tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+           taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+           tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+           tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+           do ig=1,ngrid/2  ! Northern hemisphere
+             tauref(ig)= tauN +
+     &       (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+           end do
+           do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+             tauref(ig)= tauS +
+     &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+           end do
+
+        ELSE IF ((iaervar.eq.4).or.
+     &           ((iaervar.ge.24).and.(iaervar.le.26)))
+     &       THEN  ! << "TES assimilated dust scenarios >>
+           call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+        ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+          tauref(1) = 2.5
+          if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.gt.99) THEN  ! << input netcdf file >>
+c*************WRF
+c
+c 2. customized dust opacity field
+c   ex: from assimilation
+       call meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,
+     . iaervar)
+c
+c*************WRF
+
+        ELSE
+          stop 'problem with iaervar in aeropacity.F'
+        ENDIF
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+          expfactor=0.
+          CALL zerophys(ngrid,taudusttmp)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+c             Scaling factor
+              taudusttmp(ig)=taudusttmp(ig)+aerosol(ig,l,iaer)
+            ENDDO
+          ENDDO
+
+c         Rescaling each layer to reproduce the choosen (or
+c           assimilated) dust extinction opacity at visible
+c           reference wavelength, which is originally scaled
+c           to an equivalent 700Pa pressure surface.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              aerosol(ig,l,iaer) = tauref(ig) *
+     &                     pplev(ig,1) / 700.E0 *
+     &                     aerosol(ig,l,iaer) / taudusttmp(ig)
+            ENDDO
+          ENDDO
+
+          CALL zerophys(ngrid,taudustvis)
+          CALL zerophys(ngrid,taudusttes)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              taudustvis(ig) = taudustvis(ig) + aerosol(ig,l,iaer)
+              taudusttes(ig) = taudusttes(ig) + aerosol(ig,l,iaer)*
+     &          QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer)*
+     &          ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+            ENDDO
+          ENDDO
+
+c         Outputs
+          IF (ngrid.NE.1) THEN
+            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
+     &        ' ',2,taudusttes)
+            CALL wstats(ngridmx,'taudustTES','dust abs IR',
+     &        ' ',2,taudusttes)
+          ELSE
+            CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
+          ENDIF
+
+c     changement dans le calcul de la distribution verticale          
+c     dans le cas des scenarios de poussieres assimiles
+c        if (iaervar.eq.4) THEN  ! TES
+c        call zerophys(ngrid*naerkind,tau)
+c
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+c           end do
+c        end do
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+c     $     *(pplev(ig,1)/700)
+c           end do
+c        end do
+c        endif
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c  ---------------------------------------------------------------------
+c     2) Transported radiatively active dust  (if tracer=T and active=T)
+c ----------------------------------------------------------------------
+      ELSE  IF ((tracer) .and. (active)) THEN 
+c     The dust opacity is computed from q
+
+c     a) "doubleq" technique (transport of mass and number mixing ratio)
+c        ~~~~~~~~~~~~~~~~~~~
+       if(doubleq) then 
+
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+
+c        Computing effective radius :
+         do  l=1,nlayer
+           do ig=1, ngrid
+              r0=
+     &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+              r0=min(max(r0,1.e-10),500.e-6)
+              reff= ref_r0 * r0
+cc           If  reff is small, the transported dust mean Qext
+c            is reduced from the reference dust Qext by a factor "coefsize"
+
+             coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+
+cc              It is added 1.e-8 to pq to avoid low
+
+                aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+     &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+     &          * (pq(ig,l,nqdust(1)))*
+c               only one dust bin to use with doubleq
+     &          (pplev(ig,l)-pplev(ig,l+1))/g
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+
+c     b) Size bin technique (each aerosol can contribute to opacity))
+c        ~~~~~~~~~~~~~~~~~~
+       else
+c        The dust opacity is computed from q
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         do iq=1,dustbin
+           do l=1,nlayer
+              do ig=1,ngrid
+cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+cc               It is added 1.e-8 to pq to avoid low
+                 aerosol(ig,l,1)=aerosol(ig,l,1)+
+     &           qextrhor(nqdust(iq))*(pq(ig,l,nqdust(iq))+1.e-8)*
+     &           (pplev(ig,l)-pplev(ig,l+1))/g
+              end do
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+       end if  ! (doubleq)
+      END IF   ! (dust scenario)
+
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+
+      IF (water.AND.activice) THEN
+c       1. Initialization
+        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))
+        CALL zerophys(ngrid,taucloudvis)
+        CALL zerophys(ngrid,taucloudtes)
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) =
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        ( pq(ig,l,i_ice) + 1.E-8 ) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+        ELSE
+          CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+      ENDIF
+
+c==================================================================
+        END SELECT aerkind
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+
+      do l=1,nlayer
+         do ig=1,ngrid
+               tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+         end do
+      end do
+
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_readtesassim.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_readtesassim.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/assim_readtesassim.F90	(revision 46)
@@ -0,0 +1,306 @@
+subroutine meso_readtesassim(ngrid,nlayer,zday,pplev,tauref,day_translate)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "comgeomfi.h"
+include "netcdf.inc"
+include "datafile.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 radeg,pi
+integer :: timedim,londim,latdim
+real, dimension(:), allocatable, save :: lat,lon,time
+real, dimension(:,:,:), allocatable, save :: tautes
+integer, save :: timelen,lonlen,latlen
+INTEGER, external:: lnblnk
+
+!!WRF added
+INTEGER :: day_translate 
+
+pi=acos(-1.)
+radeg=180/pi
+realday=mod(zday,669.)
+
+if (firstcall) then
+   firstcall=.false.
+
+   !! Note: datafile() is defined in "datafile.h"
+   !print *,datafile(1:lnblnk(datafile))
+   !ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/input_totoptdep.nc",NF_NOWRITE,nid)
+
+!!-------------------------------------
+!! iaervar is used here to communicate the day starting the diagfi
+!! -- in addition, inpu_totoptdep.nc must be prepared
+day_translate=day_translate-1000
+ierr=NF_OPEN ("./input_totoptdep.nc",NF_NOWRITE,nid)
+!!-------------------------------------
+
+
+   IF (ierr.NE.NF_NOERR) THEN
+     !write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+     !write(*,*)'It should be in :',datafile(1:lnblnk(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'
+     write(*,*)'Problem opening input_totoptdep.nc ...'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"lat",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"lon",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, "totoptdep",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 <totoptdep> not found"
+      stop
+   ENDIF
+
+!!****WRF
+!! diagfi files feature the dust opacity divided by 700 Pa
+        tautes=tautes*700.
+!!****WRF
+
+
+   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
+
+!!****WRF
+PRINT *, "**** read assimilation dust"
+PRINT *, "prescribed starting day ...", day_translate
+time=time+day_translate
+!!****WRF
+
+   ierr = NF_INQ_VARID (nid, "lat",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, "lon",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)
+
+!!   tauref(ig)=tau*700/pplev(ig,1)*0.8
+    tauref(ig)=tau*0.825
+
+!-------------
+! from Oxford
+!-------------
+! + tuning ... TES is little bit too hot compared to radio-occultations 
+! 0.825 is the MY24 value
+!tauref(ig)=tau*700.*0.825
+!tauref(ig)=tau*700.
+!tauref(ig)=tau*700.*1.2
+!tauref(ig)=tau*700.*0.6
+!-------------------------------------------------
+! NB: multiply by 700. is now done elsewhere
+!-------------------------------------------------
+
+
+enddo
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blackl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blackl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blackl.F	(revision 46)
@@ -0,0 +1,20 @@
+      subroutine blackl(blalong,blat,blae)
+c.......................................................................
+      implicit double precision (a-h,o-z)
+c.......................................................................
+c.....donnees de fond
+      sigma=5.6693d-08
+      pi=datan(1.d0)*4.d0
+      c0=2.9979d+08
+      h=6.6262d-34
+      cbol=1.3806d-23
+      rind=1.d0
+      c=c0/rind
+      c1=h*(c**2)
+      c2=h*c/cbol
+c.....fin de donnees de fond
+c.......................................................................
+      blae=2.d0*pi*c1/blalong**5/(dexp(c2/blalong/blat)-1.d0)
+c.......................................................................
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blendrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blendrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/blendrad.F	(revision 46)
@@ -0,0 +1,60 @@
+      subroutine blendrad(ngrid, nlayer, pplay,
+     &                    zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+c
+c  Combine radiative tendencies.  LTE contributions (zdtsw and zdtlw)
+c  have been calculated for the first NLAYLTE layers, zdtnirco2 and
+c  zdtnlte have been calculated for all nlayer layers (but zdtnlte may
+c  be zero low down).  zdtlw is phased out in favour of zdtnlte with
+c  height; zdtsw is also phased out to remove possible spurious heating
+c  at low pressures.  The pressure at which the transition occurs and
+c  the scale over which this happens are set in the nlteparams.h file.
+c  Above layer NLAYLTE the tendency is purely the sum of NLTE contributions.
+c  (Note : nlaylte is calculated by "nlthermeq" and stored in common "yomlw.h")
+c  Stephen Lewis 6/2000 FF 
+c
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+
+c     Input:
+      integer ngrid, nlayer
+      real pplay(ngrid, nlayer)
+      real zdtlw(ngrid, nlayer)
+      real zdtsw(ngrid, nlayer)
+      real zdtnirco2(ngrid, nlayer)
+      real zdtnlte(ngrid, nlayer)
+c
+c     Output:
+      real dtrad(ngrid, nlayer)
+c
+c     Local:
+      integer l, ig
+      real alpha
+c
+c     This is split into two loops to minimize number of calculations,
+c     but for vector machines it may be faster to perform one big
+c     loop from 1 to nlayer and remove the second loop.
+c
+c     Loop over layers for which zdtsw/lw have been calculated.
+      do l = 1,nlaylte 
+         do ig = 1, ngrid
+c           alpha is actually 0.5*(1+tanh((z-ztrans)/zw))
+c           written here in a simpler form, with z=-ln(p) and zwi=2/zw
+            alpha = 1./(1.+(pplay(ig,l)/ptrans)**zwi)
+            dtrad(ig,l) = (1.-alpha)*(zdtsw(ig,l)+zdtlw(ig,l))
+     &                  + zdtnirco2(ig,l) + alpha*zdtnlte(ig,l)
+         enddo
+      enddo
+c
+c     Faster loop over any remaining layers.
+      do l = nlaylte+1, nlayer
+         do ig = 1, ngrid
+            dtrad(ig,l) = zdtnirco2(ig,l) + zdtnlte(ig,l)
+         enddo
+      enddo
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callkeys.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callkeys.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callkeys.h	(revision 46)
@@ -0,0 +1,1 @@
+link ../../../meso_callkeys_newphys.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callradite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callradite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callradite.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/callradite.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim.F	(revision 46)
@@ -0,0 +1,158 @@
+      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt, rnuclei, rice,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c      Sedimentation of the  Martian aerosols
+c      depending on their density and radius
+c
+c      F.Forget 1999
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+#include "callkeys.h"
+
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid              ! number of horizontal grid points
+      INTEGER nlay               ! number of atmospheric layers
+      REAL ptimestep             ! physics time step (s)
+      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+c    Aerosol radius provided by the water ice microphysical scheme:
+      REAL rnuclei(ngrid,nlay)   ! Prescribed dust radius in each layer (m)
+      REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+
+c    Traceurs :
+      integer nq             ! number of tracers
+      real pq(ngrid,nlay,nq)  ! tracers (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, iq
+
+      real zqi(ngridmx,nlayermx) ! to locally store tracers
+      real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
+      real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
+      real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
+c      real dens(ngridmx,nlayermx) ! Mean density of the ice part. accounting for dust core
+      real rfall(ngridmx,nlayermx)
+
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans callsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+      
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+c
+c     Calcul preliminaires  de caracteristiques des couches
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g 
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+      do iq=1,nq
+        if(radius(iq).gt.1.e-9) then   ! no sedim for gaz (defined by radius=0)
+
+c         On "update" la valeur de q apres les autres parametrisations
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          do l=1,nlay
+            do ig=1,ngrid
+              ! store locally updated tracers
+              zqi(ig,l)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+!              if (iceparty.and.iq.eq.nq-1) then
+              if (water.and.(iq.eq.igcm_h2o_ice)) then
+c               On affecte un rayon moyen aux poussieres a chaque altitude du type :
+c               r(z)=r0*exp(-z/H) avec r0=0.8 micron et H=18 km.
+c               ''''''''''''''''''''''''''''''''''''''''''''''''
+                rfall(ig,l)=max( rice(ig,l)*1.5,rnuclei(ig,l) )
+c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
+                rfall(ig,l)=min(rfall(ig,l),1.e-4)
+!mars commente pour l'instant               rfall(ig,l)=20.e-6
+              endif
+            enddo
+          enddo ! of do l=1,nlay
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!          if(iceparty.and.iq.eq.nq-1) then
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+     &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi,wq)
+          else
+            call newsedim(ngrid,nlay,1,ptimestep,
+     &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),zqi,wq)
+          endif
+
+c         Calcul des tendances
+c         ~~~~~~~~~~~~~~~~~~~~
+          do ig=1,ngrid 
+!            if(iceparty.and.iq.eq.nq-1) then
+!                pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+!            else
+!                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+!            endif
+! Temporary: surface ice is qsurf(igcm_h2o_vap) ! no more
+!            if(iceparty.and.(iq.eq.igcm_h2o_ice)) then
+!                pdqs_sed(ig,igcm_h2o_vap) = wq(ig,1)/ptimestep 
+!            else
+!                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+!            endif
+! Ehouarn: with new way of tracking tracers by name, it should now simply be
+            pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+          end do
+
+          DO l = 1, nlay
+            DO ig=1,ngrid
+c	      zqi(ig,l)=max(zqi(ig,l), 1.e-10)
+              pdqsed(ig,l,iq)=(zqi(ig,l)-
+     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+
+        endif ! of if(radius(iq).gt.1.e-9)
+      enddo ! of do iq=1,nq
+ 
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim2q.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim2q.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/callsedim2q.F	(revision 46)
@@ -0,0 +1,330 @@
+      SUBROUTINE callsedim2q(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Sedimentation of the  Martian dust 
+c      using method with mass (iq=1) and number(iq=2) mixing ratio
+c
+c      F.Forget 1999
+c
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid              ! number of horizontal grid points
+      INTEGER nlay               ! number of atmospheric layers
+      REAL ptimestep             ! physics time step (s)
+      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+
+
+c    Traceurs :
+      integer nq                 ! number of tracers
+      real pq(ngrid,nlay,nq)     ! tracer (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      INTEGER iq
+      real zq(ngridmx,nlayermx,2) ! to locally store dust tracers
+      real masse(ngridmx,nlayermx)      ! Layer mass (kg.m-2)
+      real epaisseur(ngridmx,nlayermx)  ! Layer thickness (m)
+      real wq(ngridmx,nlayermx+1)       ! moved tracer mass (kg.m-2)
+      real r0(ngridmx,nlayermx)         ! geometric mean radius (m)
+
+
+c     Discretisation en taille:
+c     ~~~~~~~~~~~~~~
+c       1) Discretisation pour representer la variation de Vitesse de chute
+      integer nr,ir
+      parameter (nr=7)   ! nombre de rayon pour le calcul du transport
+      real rd(nr),qr(ngridmx,nlayermx,nr)
+      real rdi(nr+1)    ! extreme and intermediate radii
+      real Sq(ngridmx,nlayermx)
+      real rdmin,rdmax,rdimin,rdimax
+      data rdmin/1.e-7/
+      data rdmax/30.e-6/
+      data rdimin/1.e-10/
+      data rdimax/1e-4/
+      save rd, rdi
+
+c       2) Sous discretisation pour bien integrer la loi lognormale
+c          (calcul de q pour chaque gamme de rayon rd)
+
+      integer nint, iint   
+      parameter (nint=4)  ! nombre de point entre chaque rayon rdi
+      real rr(nint,nr)
+      save rr
+      
+      real reff(ngridmx,nlayermx,2)  ! for diagnostic only
+      
+      INTEGER idust_mass   ! index of tracer containing dust mass mix. ratio
+      INTEGER idust_number ! index of tracer containing dust number mix. ratio
+      INTEGER niq(2)       ! to store the indexes corresponding to dust
+      SAVE idust_mass,idust_number,niq
+
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            Print*,'STOP dans coefdifv'
+            Print*,'probleme de dimensions :'
+            Print*,'ngrid  =',ngrid
+            Print*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+ 
+         do ir=1,nr
+             rd(ir)= rdmin*(rdmax/rdmin)**(float(ir-1)/float(nr-1))
+c            rd(ir) = rdmin + (float(ir-1)/float(nr-1))*(rdmax-rdmin)
+         end do
+         rdi(1)=rdimin
+         do ir=2,nr
+           rdi(ir)= sqrt(rd(ir-1)*rd(ir))
+         end do
+         rdi(nr+1)=rdimax
+
+         do ir=1,nr
+           do iint=1,nint
+             rr(iint,ir)=
+     &       rdi(ir)*(rdi(ir+1)/rdi(ir))**(float(iint-1)/float(nint-1))
+c             write(*,*) rr(iint,ir)
+           end do
+         end do
+
+      ! identify tracers corresponding to mass mixing ratio and
+      ! number mixing ratio
+        idust_mass=0      ! dummy initialization
+        idust_number=0    ! dummy initialization
+        
+        do iq=1,nq
+          if (noms(iq).eq."dust_mass") then
+            idust_mass=iq
+            niq(1)=idust_mass
+          endif
+          if (noms(iq).eq."dust_number") then
+            idust_number=iq
+            niq(2)=idust_number
+          endif
+        enddo
+        
+        ! check that we did find the tracers
+        if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
+          write(*,*) 'callsedim2q: error! could not identify tracers'
+          write(*,*) '         for dust mass and number mixing ratio' 
+          stop
+        endif
+        
+      ENDIF ! of IF (firstcall)
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q apres les autres parametrisations
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,2
+        do l=1,nlay
+          do ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep
+! unrolling loop in iq would amount to:
+            ! dust mass mixing ratio
+!            zq(ig,l,1)=pq(ig,l,idust_mass)
+!     &                     +pdqfi(ig,l,idust_mass)*ptimestep
+            ! dust number mixing ratio
+!            zq(ig,l,2)=pq(ig,l,idust_number)
+!     &                     +pdqfi(ig,l,idust_number)*ptimestep
+          enddo
+        enddo
+      enddo
+
+
+c    Calcul preliminaires  de caracteristiques des couches
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+
+c     Calcul de la distribution de taille
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      do  l=1,nlay
+         do ig=1, ngrid
+              r0(ig,l)=
+     &        (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+              r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+         end do
+      end do
+
+      DO iq=1,2  ! LOOP on Mass (iq=1) then Number(iq=2) mixing ratio
+
+c        Calcul du rapport de melange pour les nir tailles considerees
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          call zerophys(ngridmx*nlayermx, Sq)
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+c                **************** nouvelle methode :
+c                Calcul de q pour chaque gamme de rayon rd
+c                Sous discretisation pour bien integrer la loi lognormale
+c                (Methode des trapezes)
+                 qr(ig,l,ir)=0.5*(rr(2,ir)-rr(1,ir))*
+     &             (rr(1,ir)**(5-3*iq))*
+     &             exp(-(log(rr(1,ir)/r0(ig,l)))**2/(2*varian**2))
+                 do iint=2,nint-1
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(iint+1,ir)-rr(iint-1,ir))*
+     &             (rr(iint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(iint,ir)/r0(ig,l)))**2/(2*varian**2))
+                 end do
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(nint,ir)-rr(nint-1,ir))*
+     &             (rr(nint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(nint,ir)/r0(ig,l)))**2/(2*varian**2))
+
+c                **************** Methode simple BUGGEE
+c                qr(ig,l,ir)=(rd(ir)**(5-3*iq))*
+c    &           exp( -(log(rd(ir)/r0(ig,l)))**2 / (2*varian**2) )
+c                ******************************
+                 Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir) 
+              enddo
+            enddo
+          enddo
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+                 qr(ig,l,ir)= zq(ig,l,iq)* qr(ig,l,ir)/Sq(ig,l)
+              enddo
+            enddo
+c          write(123,*) rd(ir)*1.e6, qr(1,10,ir)
+          enddo
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          call zerophys(ngridmx*nlayermx,zq(1,1,iq))
+          call zerophys(ngridmx*nlayermx,pdqs_sed(1,niq(iq)))
+
+c         write(*,*)
+c         if(iq.eq.1) write(*,*) '5 fois  wq(6), wq(7), q(6)'
+          
+          do ir=1,nr
+             call newsedim(ngrid,nlay,1,ptimestep,
+     &       pplev,masse,epaisseur,pt,rd(ir),rho_dust,qr(1,1,ir),wq)
+
+c            Calcul des tendances
+c            ~~~~~~~~~~~~~~~~~~~~
+             do ig=1,ngrid
+               pdqs_sed(ig,niq(iq)) = pdqs_sed(ig,niq(iq))
+     &                                + wq(ig,1)/ptimestep
+             end do
+             DO l = 1, nlay
+               DO ig=1,ngrid
+                 zq(ig,l,iq)=zq(ig,l,iq)+qr(ig,l,ir)
+               ENDDO
+             ENDDO
+c         if(iq.eq.1) write(*,*) 'callsed: wq(6), wq(7), q(6)',
+c    &               wq(1,6),wq(1,7),qr(1,6,ir)
+
+c               if(iq.eq.1)write(*,*)'R=', rd(ir)*1.e6
+c               write(*,*)
+          enddo ! of do ir=1,nr
+
+          do l = 1, nlay
+            do ig=1,ngrid
+              pdqsed(ig,l,niq(iq))=(zq(ig,l,iq)-
+     $             (pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep)
+     &                              )/ptimestep
+            enddo
+          enddo
+
+c     ***** Diagnostique *****************
+c         call zerophys(ngridmx*nlayermx,reff(1,1,iq))
+c         do ir=1,nr
+c           do l = 1, nlay
+c             do ig=1,ngrid
+c              if(iq.eq.1) then 
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)/rd(ir)
+c              else
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)*log(rd(ir))
+c              endif
+c             enddo
+c           enddo
+c         enddo
+c         do l = 1, nlay
+c           do ig=1,ngrid
+c            if(iq.eq.1) then 
+c             reff(ig,l,iq)=zq(ig,l,iq)/reff(ig,l,iq)
+c            else
+c             reff(ig,l,iq)=exp(reff(ig,l,iq)/zq(ig,l,iq))
+c            endif
+c           enddo
+c         enddo
+c     **** FIN Diagnostique *****************
+
+      enddo  ! end loop on iq=1,2
+
+
+
+c ********************************************
+c     Diagnostique
+c     if(ngrid.eq.1) then
+c      do  l=1,nlay
+c       do ig=1, ngrid
+c         r0(ig,l)=
+c    &    (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+c         r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+c
+c         write(*,*)'l,r0, r02 ', l, r0(ig,l),reff(ig,l,1)*0.3626
+c    &    ,reff(ig,l,2)
+c    &    ,r0(ig,l)/(reff(ig,l,1)*0.3626) 
+c
+c       end do
+c      end do
+c      CALL writeg1d(ngrid,nlay,r0,'r0','m')
+c     end if
+c ********************************************
+
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/co2snow.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/co2snow.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/co2snow.F	(revision 46)
@@ -0,0 +1,140 @@
+      SUBROUTINE co2snow (ngrid,nlayer,ptimestep,emisref,condsub,pplev,
+     &        pcondicea,pcondices,pfallice,pemisurf)
+
+       IMPLICIT NONE
+
+c=======================================================================
+c     Program for simulate the impact of the CO2 snow fall on
+c     the surface infrared emission (emissivity)  and on 
+c     the airborne dust
+c     F.Forget 1996
+c=======================================================================
+
+c Declarations
+c ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "callkeys.h"
+
+c     input
+c     -----
+
+      INTEGER ngrid,nlayer
+      REAL ptimestep , emisref(ngrid) ! grd or ice  emissivity without snow
+      logical condsub(ngrid)
+
+      REAL pplev(ngrid,nlayer+1)
+      REAL pcondicea(ngrid,nlayer), pcondices(ngrid)
+      REAL pfallice(ngrid,nlayer+1)
+
+c     output
+c     ------
+
+      REAL pemisurf(ngrid)
+
+c     local
+c     -----
+      integer ig , l , icap
+
+      REAL zdemisurf ,dtemis
+      REAL sumdaer
+
+c     saved
+c     -----
+      REAL Kscat(2), scaveng
+      LOGICAL firstcall
+      SAVE firstcall
+      save Kscat , scaveng
+      DATA firstcall/.true./
+
+c --------------
+c Initialisation
+c --------------
+
+      if (firstcall) then
+
+c   Kscat : coefficient for decreasing the surface emissivity
+c           =(0.001/3.)*alpha/iceradius ,
+c           with 0.3< alpha < 0.6, set to 0.45 (coeff from emis = f (tau))
+c           and iceradius the mean radius of the
+c           scaterring particles  (200.e-6<iceradius<10.e-6)
+
+            Kscat(1)=(0.001/3.)*0.45/iceradius(1)
+            Kscat(2)=(0.001/3.)*0.45/iceradius(2)
+
+c          Scavenging Ratio (dust concentration in the air / in the snow)
+           scaveng = 100.0
+           
+c          Collision Scavenging coefficient  (m2.kg-1)
+c          Csca  = 2.3  ! not used yet !!!!!!!!!!!
+           firstcall = .false.
+
+      end if
+
+
+c     LOOP on grid points
+c     -------------------
+      do ig=1,ngrid 
+         if (condsub(ig)) then
+
+c         IF (scavenging) then
+c          Airborne Dust 
+c          -------------
+c          sumdaer=0.
+c          do l=nlayer, 1, -1
+c             pdaerosol(ig,l)= -paerosol(ig,l,1)*
+c    &              (1-exp(-scaveng*pcondicea(ig,l)*ptimestep*g/
+c    &               (pplev(ig,l)-pplev(ig,l+1))))/ptimestep  
+
+c    &           - Csca*paerosol(ig,l,1) ! Scavenging by collision
+c    &           * 0.5*(pfallice(ig,l)) ! not included
+
+c             test to avoid releasing to much dust when subliming:
+c             if(pdaerosol(ig,l).gt.-sumdaer)pdaerosol(ig,l)=-sumdaer 
+c             sumdaer=sumdaer + pdaerosol(ig,l)
+
+c            if (-pdaerosol(ig,l)*ptimestep.gt.paerosol(ig,l,1)) then
+c                write(*,*) 'ds co2snow: aerosol < 0.0 !!!'
+c                write(*,*) 'ig =' , ig
+c            end if
+c          end do
+c         END IF
+
+c          Surface emissivity
+c          ------------------
+c   dtemis: Time scale for increasing the ice emissivity
+
+           IF(ig.GT.ngrid/2+1) THEN
+              icap=2
+           ELSE
+              icap=1
+           ENDIF
+
+           zdemisurf = 
+     &    (emisref(ig)-pemisurf(ig))/(dtemisice(icap)*daysec) 
+c Using directly the diferential equation:
+c    &       -Kscat(icap)*emisref(ig)*
+c    &      (pemisurf(ig)/emisref(ig))**4 *pfallice(ig,1) 
+c Using an integrated form for numerical safety instead
+     & +(emisref(ig)* ((pemisurf(ig)/emisref(ig))**(-3)+3.*Kscat(icap)*
+     & pfallice(ig,1)*ptimestep)**(-1/3.) -pemisurf(ig))/ptimestep   
+
+
+           pemisurf(ig) = pemisurf(ig) + zdemisurf*ptimestep 
+
+           if (pemisurf(ig).lt.0.1) then
+                 write(*,*) 'ds co2snow: emis < 0.1 !!!'
+                 write(*,*) 'ig =' , ig
+                 write(*,*)'pemisurf(ig)',pemisurf(ig)
+                 write(*,*) 'zdemisurf*ptimestep',zdemisurf*ptimestep
+           end if
+         else
+           pemisurf(ig) = emisref(ig)
+         end if
+      end do
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comcstfi.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comcstfi.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comcstfi.h	(revision 46)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+! INCLUDE "comcstfi.h"
+
+      common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
+      real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comdiurn.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comdiurn.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comdiurn.h	(revision 46)
@@ -0,0 +1,5 @@
+      COMMON/comdiurn/ldiurn,
+     s     sinlon(ngridmx),coslon(ngridmx),
+     s     sinlat(ngridmx),coslat(ngridmx)
+      REAL sinlon,coslon,sinlat,coslat
+      LOGICAL ldiurn
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comg1d.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comg1d.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comg1d.h	(revision 46)
@@ -0,0 +1,59 @@
+c.......................................................................
+c  le COMMON pour GRADS-1D
+c  (Utilise pour les sorties format Grads dans la version 1D du modele)
+c
+c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+c
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+c
+c         * g1d_nlayer     ---> nombre de couches verticales
+c         * g1d_nomfich    ---> nom du fichier grads
+c         * g1d_unitfich   ---> code du fichier grads
+c         * g1d_nomctl     ---> nom du fichier ctl
+c         * g1d_unitctl    ---> code du fichier ctl
+c         * g1d_premier    ---> variable logique pour dire si le fichier
+c                               est deja ouvert
+c         * g1d_irec       ---> indice de derniere ecriture
+c         * g1d_nvar       ---> nombre de variables deja definies a la
+c                               derniere ecriture
+c         * g1d_nomvar     ---> noms des vecteurs existants
+c         * g1d_dimvar     ---> taille des vecteurs
+c         * g1d_titrevar   ---> titres des vecteurs
+c         * g1d_tmp1       ---> caractere 
+c         * g1d_tmp2       ---> caractere 
+c
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+c
+      COMMON/COMG1DI/g1d_nlayer
+     &             ,g1d_unitfich
+     &             ,g1d_unitctl
+     &             ,g1d_irec
+     &             ,g2d_irec
+     &             ,g2d_appel
+     &             ,g1d_nvar
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
+     &             ,g1d_nomfich
+     &             ,g1d_nomctl
+     &             ,g1d_nomvar(0:g1d_nvarmx)
+     &             ,g1d_titrevar(0:g1d_nvarmx)
+     &             ,g1d_tmp1
+     &             ,g1d_tmp2
+      COMMON/COMG1DL/g1d_premier
+     &             ,g2d_premier
+c
+c.......................................................................
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comgeomfi.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comgeomfi.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comgeomfi.h	(revision 46)
@@ -0,0 +1,4 @@
+      COMMON/comgeomfi1/long(ngridmx),lati(ngridmx),area(ngridmx)
+      COMMON/comgeomfi2/ totarea
+
+      REAL long,lati,area,totarea
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comorbit.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comorbit.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comorbit.h	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comorbit.h'
+
+      COMMON/comorbit/aphelie,periheli,year_day,
+     $       peri_day,timeperi,obliquit,
+     $       e_elips,p_elips,unitastr,pi
+
+      REAL aphelie,periheli,year_day,
+     $  peri_day,timeperi,obliquit,
+     $  e_elips,p_elips,unitastr,pi
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsaison.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsaison.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsaison.h	(revision 46)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c   INCLUDE saison.h
+
+      COMMON/saison/callsais,isaison,dist_sol,declin,
+     $             mu0(ngridmx),fract(ngridmx)
+
+      INTEGER isaison
+      LOGICAL callsais
+      REAL dist_sol,declin,mu0,fract
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsoil.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsoil.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/comsoil.h	(revision 46)
@@ -0,0 +1,7 @@
+      common/comsoil1/layer(nsoilmx),mlayer(0:nsoilmx-1)
+      common/comsoil2/inertiedat(ngridmx,nsoilmx),volcapa
+
+      real layer      ! soil layer depths
+      real mlayer     ! soil mid-layer depths
+      real inertiedat ! soil thermal inertia
+      real volcapa    ! soil volumetric heat capacity
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/convadj.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/convadj.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/convadj.F	(revision 46)
@@ -0,0 +1,350 @@
+      SUBROUTINE convadj(ngrid,nlay,nq,ptimestep,
+     S                   pplay,pplev,ppopsk,
+     $                   pu,pv,ph,pq,
+     $                   pdufi,pdvfi,pdhfi,pdqfi,
+     $                   pduadj,pdvadj,pdhadj,
+     $                   pdqadj)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   ajustement convectif sec
+c   on ajoute les tendances pdhfi au profil pdh avant l'ajustement
+c   SPECIAL VERSION : if one tracer is CO2, take into account the
+c   Molecular mass variation (e.g. when CO2 condense) to trigger
+c   convection  F. Forget 01/2005
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
+      REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
+
+c    Traceurs :
+      integer nq
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+      real pdqadj(ngrid,nlay,nq)
+
+
+c   local:
+c   ------
+
+      INTEGER ig,i,l,l1,l2,jj
+      INTEGER jcnt, jadrs(ngridmx)
+
+      REAL sig(nlayermx+1),sdsig(nlayermx),dsig(nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL zu2(ngridmx,nlayermx),zv2(ngridmx,nlayermx)
+      REAL zh2(ngridmx,nlayermx), zhc(ngridmx,nlayermx)
+      REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+      
+
+c    Traceurs :
+      INTEGER iq,ico2
+      save ico2
+      REAL zq(ngridmx,nlayermx,nqmx), zq2(ngridmx,nlayermx,nqmx)
+      REAL zqm(nqmx),zqco2m
+      real m_co2, m_noco2, A , B
+      save A, B
+c    Temporaire (for diagnostic)
+c      REAL diag_alpha(ngridmx)
+
+      real mtot1, mtot2 , mm1, mm2
+       integer l1ref, l2ref
+      LOGICAL vtest(ngridmx),down,firstcall
+      save firstcall
+      data firstcall/.true./
+
+      EXTERNAL SCOPY
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+      IF (firstcall) THEN 
+        IF(ngrid.NE.ngridmx) THEN
+           PRINT*
+           PRINT*,'STOP dans convadj'
+           PRINT*,'ngrid    =',ngrid
+           PRINT*,'ngridmx  =',ngridmx
+        ENDIF
+        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
+             end if
+           enddo
+        endif
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+c
+c-----------------------------------------------------------------------
+c   detection des profils a modifier:
+c   ---------------------------------
+c   si le profil est a modifier
+c   (i.e. ph(niv_sup) < ph(niv_inf) )
+c   alors le tableau "vtest" est mis a .TRUE. ;
+c   sinon, il reste a sa valeur initiale (.FALSE.)
+c   cette operation est vectorisable
+c   On en profite pour copier la valeur initiale de "ph"
+c   dans le champ de travail "zh"
+
+
+      DO l=1,nlay
+         DO ig=1,ngrid
+            zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
+            zu(ig,l)=pu(ig,l)+pdufi(ig,l)*ptimestep
+            zv(ig,l)=pv(ig,l)+pdvfi(ig,l)*ptimestep
+         ENDDO
+      ENDDO
+
+      if(tracer) then      
+        DO iq =1, nq
+         DO l=1,nlay
+           DO ig=1,ngrid
+              zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+
+      CALL scopy(ngrid*nlay,zh,1,zh2,1)
+      CALL scopy(ngrid*nlay,zu,1,zu2,1)
+      CALL scopy(ngrid*nlay,zv,1,zv2,1)
+      CALL scopy(ngrid*nlay*nq,zq,1,zq2,1)
+
+      DO ig=1,ngrid
+        vtest(ig)=.FALSE.
+      ENDDO
+c
+      if (ico2.ne.0) then
+c        Special case if one of the tracer is CO2 gas
+         DO l=1,nlay
+           DO ig=1,ngrid
+             zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+           ENDDO
+         ENDDO
+       else
+          CALL scopy(ngrid*nlay,zh2,1,zhc,1)
+       end if
+
+       
+
+      DO l=2,nlay
+        DO ig=1,ngrid
+          IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.TRUE.
+        ENDDO
+      ENDDO
+c
+      jcnt=0
+      DO ig=1,ngrid
+         IF(vtest(ig)) THEN
+            jcnt=jcnt+1
+            jadrs(jcnt)=ig
+         ENDIF
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c  Ajustement des "jcnt" profils instables indices par "jadrs":
+c  ------------------------------------------------------------
+c
+      DO jj = 1, jcnt   ! loop on every convective grid point
+c
+          i = jadrs(jj)
+ 
+c   Calcul des niveaux sigma sur cette colonne
+          DO l=1,nlay+1
+            sig(l)=pplev(i,l)/pplev(i,1)
+        
+          ENDDO
+         DO l=1,nlay
+            dsig(l)=sig(l)-sig(l+1)
+            sdsig(l)=ppopsk(i,l)*dsig(l)
+         ENDDO
+          l2 = 1
+c
+c      -- boucle de sondage vers le haut
+c
+cins$     Loop  vers le haut sur l2
+          DO
+c
+            l2 = l2 + 1
+            IF (l2 .GT. nlay) EXIT
+            IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+ 
+c          -- l2 est le niveau le plus haut de la colonne instable
+ 
+              l1 = l2 - 1
+              l  = l1
+              zsm = sdsig(l2)
+              zdsm = dsig(l2)
+              zhm = zh2(i, l2)
+              if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+c
+c          -- boucle de sondage vers le bas
+c             Loop
+              DO
+c
+                zsm = zsm + sdsig(l)
+                zdsm = zdsm + dsig(l)
+                zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+                if(ico2.ne.0) then
+                  zqco2m = 
+     &            zqco2m + dsig(l) * (zq2(i,l,ico2) - zqco2m) / zdsm
+                  zhmc = zhm*(A*zqco2m+B)
+                else 
+                  zhmc = zhm
+                end if
+ 
+c            -- doit on etendre la colonne vers le bas ?
+ 
+                down = .FALSE.
+                IF (l1 .NE. 1) THEN    !--  and then
+                  IF (zhmc .LT. zhc(i, l1-1)) THEN
+                    down = .TRUE.
+                  END IF
+                END IF
+ 
+                IF (down) THEN
+ 
+                  l1 = l1 - 1
+                  l  = l1
+ 
+                ELSE
+ 
+c              -- peut on etendre la colonne vers le haut ?
+ 
+                  IF (l2 .EQ. nlay) EXIT
+ 
+                  IF (zhc(i, l2+1) .GE. zhmc) EXIT
+c
+                  l2 = l2 + 1
+                  l  = l2
+c
+                END IF
+c
+cins$         End Loop
+              ENDDO
+c
+c          -- nouveau profil : constant (valeur moyenne)
+c
+              zalpha=0.
+              zum=0.
+              zvm=0.
+              do iq=1,nq
+                zqm(iq) = 0.
+              end do
+              DO l = l1, l2
+                if(ico2.ne.0) then
+                  zalpha=zalpha+
+     &            ABS(zhc(i,l)/(A+B*zqco2m) -zhm)*dsig(l)
+                else
+                  zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                endif
+                zh2(i, l) = zhm
+                zum=zum+dsig(l)*zu(i,l)
+                zvm=zvm+dsig(l)*zv(i,l)
+                do iq=1,nq
+                   zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+                end do
+              ENDDO
+              zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+              zum=zum/(sig(l1)-sig(l2+1))
+              zvm=zvm/(sig(l1)-sig(l2+1))
+              do iq=1,nq
+                 zqm(iq) = zqm(iq)/(sig(l1)-sig(l2+1))
+              end do
+
+              IF(zalpha.GT.1.) THEN
+                 zalpha=1.
+              ELSE
+c                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-4) zalpha=1.e-4
+              ENDIF
+
+              DO l=l1,l2
+                 zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                 zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                 do iq=1,nq
+c                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+                   zq2(i,l,iq)=zqm(iq)
+                 end do
+              ENDDO
+c              diag_alpha(i)=zalpha  !temporaire
+              if (ico2.ne.0) then
+                DO l=l1, l2
+                  zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+                ENDDO
+              end if
+
+ 
+              l2 = l2 + 1
+c
+            END IF   ! fin traitement instabilité entre l1 et l2. 
+c                      On repart pour test à partir du l2 au dessus...
+          ENDDO   ! End Loop sur l2 vers le haut 
+c
+      ENDDO
+c
+      DO l=1,nlay
+        DO ig=1,ngrid
+          pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+          pduadj(ig,l)=(zu2(ig,l)-zu(ig,l))/ptimestep
+          pdvadj(ig,l)=(zv2(ig,l)-zv(ig,l))/ptimestep
+        ENDDO
+      ENDDO
+
+      if(tracer) then 
+        do iq=1, nq
+          do  l=1,nlay
+            do ig=1, ngrid
+              pdqadj(ig,l,iq)=(zq2(ig,l,iq)-zq(ig,l,iq))/ptimestep 
+            end do 
+          end do 
+        end do 
+      end if
+
+c     outpu
+      if (ngrid.eq.1) then
+         ig=1
+         iq =1 
+         write(*,*)'**** l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+         do l=nlay,1,-1
+           write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+         end do
+      end if
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgp.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgp.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgp.F	(revision 46)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/cvmgt.F	(revision 46)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datafile.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datafile.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datafile.h	(revision 46)
@@ -0,0 +1,1 @@
+link ../../../meso_datafile.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datareadnc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datareadnc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/datareadnc.F	(revision 46)
@@ -0,0 +1,291 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,phisinit,alb,ith,
+     .                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+#include "datafile.h"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+      CHARACTER relief*3
+
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      REAL        alb(iimp1*jjp1)
+      REAL        ith(iimp1*jjp1)
+      REAL        phisinit(iimp1*jjp1)
+
+      REAL        zmea(imdp1*jmdp1)
+      REAL        zstd(imdp1*jmdp1)
+      REAL        zsig(imdp1*jmdp1)
+      REAL        zgam(imdp1*jmdp1)
+      REAL        zthe(imdp1*jmdp1)
+
+      INTEGER   lnblnk, ierr
+      EXTERNAL    lnblnk
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmxgdat
+      PARAMETER (klatdat=180,ngridmxgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(4)
+
+      CHARACTER*80    file
+
+#include "lmdstd.h"
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      write(*,*) 'ouverture du fichier surface.nc'
+
+      ierr = NF_OPEN (datafile(1:lnblnk(datafile))//'/surface.nc',
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file surface.nc '
+        write(*,*)'(in phymars/datareadnc.F)'
+        write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary surface.nc (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        CALL ABORT
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' La topographie est celle de MOLA'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=1,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          call multscal(imd*jmdp1,zdata,1000.,zdata)
+          call multscal(imd,longitude,pi/180.,longitude)
+          call multscal(jmdp1,latitude,pi/180.,latitude)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          CALL dump2d(iip1,jjp1,zmea,'zmea')
+          CALL dump2d(iip1,jjp1,zstd,'zstd')
+          CALL dump2d(iip1,jjp1,zsig,'zsig')
+          CALL dump2d(iip1,jjp1,zgam,'zgam')
+          CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      DO i=1,iimp1*jjp1
+            phisinit(i)=1000.*phisinit(i)
+      ENDDO
+      CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
+      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/def_var.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/def_var.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/def_var.F90	(revision 46)
@@ -0,0 +1,61 @@
+subroutine def_var(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+
+! This subroutine defines variable 'name' in a (pre-existing and opened)
+! NetCDF file (known from its NetCDF ID 'nid').
+! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+! corresponding dimensions must be set (in array 'dimids').
+! Upon successfull definition of the variable, 'nvarid' contains the
+! NetCDF ID of the variable.
+! The variables' attributes 'title' (Note that 'long_name' would be more
+! appropriate) and 'units' are also set. 
+
+implicit none
+
+#include "netcdf.inc"
+
+integer,intent(in) :: nid ! NetCDF file ID
+character(len=*),intent(in) :: name ! the variable's name
+character(len=*),intent(in) :: title ! 'title' attribute of variable
+character(len=*),intent(in) :: units ! 'units' attribute of variable
+integer,intent(in) :: nbdim ! number of dimensions of the variable
+integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+                                              ! the variable is defined along
+integer,intent(out) :: nvarid ! NetCDF ID of the variable
+integer,intent(out) :: ierr ! returned NetCDF staus code
+
+! 1. Switch to NetCDF define mode 
+ierr=NF_REDEF(nid)
+
+! 2. Define the variable
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed defining variable "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 3. Write attributes
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+                     len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed writing title attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+                     len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed writing units attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 4. Switch out of NetCDF define mode
+ierr = NF_ENDDEF(nid)
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.cmd
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.cmd	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.cmd	(revision 46)
@@ -0,0 +1,2 @@
+touch yeye
+find * -exec diff {} $MMS/WRFV2/mars_lmd/libf/phymars/{} >> yeye \;
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log	(revision 46)
@@ -0,0 +1,9044 @@
+4c4
+<      &            ,epir,omegir,gir,qref,omegaref        )
+---
+>      &            ,epir,omegir,gir                      )
+39,40d38
+< c  * qref : extinction coefficient at reference wavelength
+< c  * omegaref : single scat. albedo at reference wavelength
+65d62
+<       REAL qextcorrdata(ndata)
+72,73c69
+<       REAL factep,qextcorr,omeg,g
+<       REAL qref,omegaref
+---
+>       REAL factep,ep,omeg,g
+102,104c98,99
+<       qref=c1*epdata(i1)+c2*epdata(i2)
+<       omegaref=c1*omegdata(i1)+c2*omegdata(i2)
+<       factep=qref/epref
+---
+>       ep=c1*epdata(i1)+c2*epdata(i2)
+>       factep=ep/epref
+106c101
+<         qextcorrdata(idata)=epdata(idata)/factep
+---
+>         epdata(idata)=epdata(idata)/factep
+152c147
+<           qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
+---
+>           ep=c1*epdata(i1)+c2*epdata(i2)
+159,161c154,156
+<           epir(iir)=epir(iir)+deltalong*emit*qextcorr
+<           omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
+<           gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
+---
+>           epir(iir)=epir(iir)+deltalong*emit*ep
+>           omegir(iir)=omegir(iir)+deltalong*emit*omeg*ep
+>           gir(iir)=gir(iir)+deltalong*emit*omeg*ep*g
+6,13c6,9
+< !      integer ndatavis
+< !      parameter(ndatavis=22)
+< !      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+< !     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+<       integer ndustvis
+<       parameter(ndustvis=22)
+<       REAL longdustvis(ndustvis),epdustvis(ndustvis)
+<      &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+---
+>       integer ndatavis
+>       parameter(ndatavis=22)
+>       REAL longdatavis(ndatavis),epdatavis(ndatavis)
+>      &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+17,24c13,16
+< !      integer ndatair
+< !      parameter(ndatair=124)
+< !      REAL longdatair(ndatair),epdatair(ndatair)
+< !     &    ,omegdatair(ndatair),gdatair(ndatair)
+<       integer ndustir
+<       parameter(ndustir=124)
+<       REAL longdustir(ndustir),epdustir(ndustir)
+<      &    ,omegdustir(ndustir),gdustir(ndustir)
+---
+>       integer ndatair
+>       parameter(ndatair=124)
+>       REAL longdatair(ndatair),epdatair(ndatair)
+>      &    ,omegdatair(ndatair),gdatair(ndatair)
+32,33c24
+< !      data longdatavis/
+<       data longdustvis/
+---
+>       data longdatavis/
+39,40c30
+< !      data epdatavis/
+<       data epdustvis/
+---
+>       data epdatavis/
+46,47c36
+< !      data omegdatavis/
+<       data omegdustvis/
+---
+>       data omegdatavis/
+53,54c42
+< !      data gdatavis/
+<       data gdustvis/
+---
+>       data gdatavis/
+60,61c48
+< !      data longdatair/
+<       data longdustir/
+---
+>       data longdatair/
+87,88c74
+< !      data epdatair/
+<       data epdustir/
+---
+>       data epdatair/
+114,115c100
+< !      data omegdatair/
+<       data omegdustir/
+---
+>       data omegdatair/
+141,142c126
+< !      data gdatair/
+<       data gdustir/
+---
+>       data gdatair/
+12a13,18
+> c   The purpose of this subroutine is
+> c      1) Make some initial calculation at first call
+> c      2) Split the calculation in several sub-grid
+> c        ("sub-domain") to save memory and
+> c        be able run on a workstation at high resolution
+> c        The sub-grid size is defined in dimradmars.h
+18,22d23
+< c   changes:
+< c   -------
+< c   > J.-B. Madeleine 09W30
+< c   Removed the variable's splitting, which is now obsolete.
+< c
+50a52
+> #include "dimradmars.h"
+71a74,76
+>       INTEGER ndomain
+>       parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+> 
+72a78
+>       INTEGER jd,ig0,nd
+77c83,92
+<       INTEGER zidx(ngridmx)
+---
+> 
+>       REAL zplev(ndomainsz,nlayermx+1)
+>       REAL zplay(ndomainsz,nlayermx)
+>       REAL zt(ndomainsz,nlayermx)
+>       REAL zu(ndomainsz,nlayermx)
+>       REAL zv(ndomainsz,nlayermx)
+>       INTEGER zidx(ndomainsz)
+>       REAL zzdtgw(ndomainsz,nlayermx)
+>       REAL zzdugw(ndomainsz,nlayermx)
+>       REAL zzdvgw(ndomainsz,nlayermx)
+99a115,126
+> 
+>          if (ngridmx .EQ. 1) then
+>            if (ndomainsz .NE. 1) then
+>              print*
+>              print*,'ATTENTION !!!'
+>              print*,'pour tourner en 1D, meme pour drag_noro '
+>              print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+>              print*
+>              call exit(1)
+>            endif
+>          endif
+> 
+103,104c130,142
+< c       Detecting points concerned by the scheme
+< c       ----------------------------------------
+---
+> 
+> c     Starting loop on sub-domain
+> c     ----------------------------
+> 
+>       DO jd=1,ndomain
+>         ig0=(jd-1)*ndomainsz
+>         if (jd.eq.ndomain) then
+>           nd=ngridmx-ig0
+>         else
+>           nd=ndomainsz
+>         endif
+> 
+> c    selection des points pour lesquels le shema est actif:
+107c145
+<         DO ig=1, ngrid
+---
+>         DO ig=ig0+1,ig0+nd
+113c151
+<             zidx(igwd)=ig
+---
+>             zidx(igwd)=ig - ig0
+117a156,174
+> c       Spliting input variable in sub-domain input variables
+> c       ---------------------------------------------------
+> 
+>         do l=1,nlayer+1
+>           do ig = 1,nd
+>            zplev(ig,l) = pplev(ig0+ig,l)
+>           enddo
+>         enddo
+> 
+>         do l=1,nlayer
+>           do ig = 1,nd
+>             zplay(ig,l) = pplay(ig0+ig,l)
+>             zt(ig,l) = pt(ig0+ig,l)
+>             zu(ig,l) = pu(ig0+ig,l)
+>             zv(ig,l) = pv(ig0+ig,l)
+>           enddo
+>         enddo
+> 
+> 
+121,126c178,183
+<         call drag_noro (ngrid,nlayer,ptimestep,pplay,pplev,
+<      e            zstd,zsig,zgam,zthe,
+<      e            igwd,igwdim,zidx,itest,
+<      e            pt, pu, pv,
+<      s            zulow,zvlow,zustr,zvstr,
+<      s            pdtgw,pdugw,pdvgw)
+---
+>         call drag_noro (nd,nlayer,ptimestep,zplay,zplev,
+>      e            zstd(ig0+1),zsig(ig0+1),zgam(ig0+1),zthe(ig0+1),
+>      e            igwd,igwdim,zidx,itest(ig0+1),
+>      e            zt, zu, zv,
+>      s            zulow(ig0+1),zvlow(ig0+1),zustr(ig0+1),zvstr(ig0+1),
+>      s            zzdtgw,zzdugw,zzdvgw)
+129,130c186,188
+< c       Dividing by ptimestep (true tendancies)
+< c       ---------------------------------------
+---
+> c       Un-spliting output variable from sub-domain input variables
+> c       ------------------------------------------------------------
+> c       (and devide by ptimestep -> true tendancies)
+133,136c191,194
+<          do ig = 1, ngrid
+<           pdtgw(ig,l) = pdtgw(ig,l)/ptimestep
+<           pdugw(ig,l) = pdugw(ig,l)/ptimestep
+<           pdvgw(ig,l) = pdvgw(ig,l)/ptimestep
+---
+>          do ig = 1,nd
+>           pdtgw(ig0+ig,l) = zzdtgw(ig,l)/ptimestep
+>           pdugw(ig0+ig,l) = zzdugw(ig,l)/ptimestep
+>           pdvgw(ig0+ig,l) = zzdvgw(ig,l)/ptimestep
+139a198,199
+>       ENDDO         !   (boucle jd=1, ndomain)
+> 
+1c1,2
+<       SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+---
+>       SUBROUTINE callradite(icount,ngrid,nlayer,
+>      $     aerosol,albedo,
+3,4c4,5
+<      $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+<      &     tauref,tau,aerosol,rice,nuice)
+---
+>      $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+> 
+19c20,22
+< c   and stored in common "yomlw.h").
+---
+> c   and stored in common "yomlw.h"
+> c      
+> c
+21c24
+< c   The purpose of this subroutine is to:
+---
+> c   The purpose of this subroutine is
+23,25c26,30
+< c      2) Compute the 3D scattering parameters depending on the
+< c        size distribution of the different tracers (added by JBM)
+< c      3) call "lwmain" and "swmain"
+---
+> c      2) Split the calculation in several sub-grid
+> c        ("sub-domain") to save memory and
+> c        be able run on a workstation at high resolution
+> c        The sub-grid size is defined in dimradmars.h
+> c       3) call "lwmain" and "swmain"
+28c33
+< c   authors:   
+---
+> c   author:   
+30,31c35
+< c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+< c
+---
+> c           Francois Forget / Christophe Hourdin
+33,76c37,38
+< c   3D scattering scheme user's guide (J.-B. Madeleine)
+< c   ---------------------------------
+< c
+< c   This routine has been modified to take into account 3D, time
+< c   dependent scattering properties of the aerosols.
+< c---- The look-up tables that contain the scattering parameters
+< c   of a given tracer, for different sizes, are read by SUAER.F90.
+< c   The names of the corresponding ASCII files have to be set in
+< c   this subroutine (file_id variable), and files must be in the
+< c   directory specified in datafile.h. Be careful: discretization of
+< c   the particle size in the ASCII files MUST BE DONE using a
+< c   volume-ratio size distribution. This means that the volume of
+< c   particles in a size bin equals the volume of particles in the next
+< c   size bin multiplied by a constant volume ratio "Vrat". In other
+< c   words: v_(i) = Vrat * v_(i-1), and radius in the ASCII files must
+< c   obey the equation r_(i) = Vrat^(1/3) * r_(i-1). For a given number
+< c   of size bins "Nb", Vrat = (r_max/r_min)^(3/(Nb-1)).
+< c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+< c   the scattering parameters in each GCM channel, using the three last
+< c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+< c---- These look-up tables, loaded during the firstcall, are then
+< c   constantly used by the subroutine "aeroptproperties.F" to compute,
+< c   online, the 3D scattering parameters, based on the size distribution
+< c   (reffrad and nueffrad) of the different tracers, in each grid box.
+< c   This 3D size distribution is loaded by the "updatereffrad.F"
+< c   subroutine. A log-normal distribution is then assumed in
+< c   "aeroptproperties.F".
+< c---- The optical depth at the visible reference wavelength (set in
+< c   SUAER.F90, after the file_id variable) is then computed by
+< c   the subroutine "aeropacity.F", by using the size and spatial
+< c   distribution of the corresponding tracer. This connection has to
+< c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+< c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+< c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+< c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+< c   swmain.F to solve the radiative transfer equation.
+< c
+< c   changes:
+< c   -------
+< c
+< c   > SRL 7/2000
+< c   
+< c   This version has been modified to only calculate radiative tendencies
+< c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+---
+> c   This version modified to only calculate radiative tendencies over
+> c   layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+79a42
+> c   SRL 7/2000
+81,84c44
+< c   > J.-B. Madeleine 09W30
+< c
+< c   Removed the variable's splitting, which is now obsolete.
+< c
+---
+> c   definition:
+96,99d55
+< c   nq                    Number of tracer
+< c   ls                    Solar longitude (Ls) , radian
+< c   zday                  Date (time since Ls=0, in martian days)
+< c   pq(ngrid,nlayer,nq)   Advected fields
+100a57,61
+> c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+> c                         at reference wavelength "longrefvis" set
+> c                         in dimradmars.h , in each layer, for one of
+> c                         the "naerkind" kind of aerosol optical properties.  
+> c 
+106,108c67
+< c   emis                  Thermal IR surface emissivity (no unit)
+< c   mu0(ngridmx)           cos of solar zenith angle
+< c                           (=1 when sun at zenith)
+---
+> c   mu0(ngridmx)           cos of solar zenith angle (=1 when sun at zenith)
+118,120d76
+< c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+< c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+< 
+134,141d89
+< c   tauref       Prescribed mean column optical depth at 700 Pa 
+< c   tau          Column total visible dust optical depth at each point
+< c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+< c                         at reference wavelength "longrefvis" set
+< c                         in dimradmars.h , in each layer, for one of
+< c                         the "naerkind" kind of aerosol optical
+< c                         properties.
+< 
+158,159c106,107
+<       INTEGER icount        
+<       INTEGER ngrid,nlayer,nq 
+---
+>       INTEGER Icount        
+>       INTEGER ngrid,nlayer  
+162c110
+<       REAL pq(ngrid,nlayer,nq)
+---
+>       REAL aerosol(ngrid,nlayer,naerkind)
+164d111
+<       REAL ls,zday
+172a120,121
+>       REAL flux(ngridmx,6)
+> 
+174,177d122
+<       REAL tauref(ngrid), tau(ngrid,naerkind)
+<       REAL aerosol(ngrid,nlayer,naerkind)
+<       REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+<       REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+182c127,128
+<       INTEGER j,l,ig,n
+---
+>       INTEGER l,ig, n
+>       INTEGER jd,j,ig0,nd
+186,187c132,135
+<       REAL dp(ngrid,nflev)
+<       REAL dt0(ngrid)
+---
+> 
+> 
+>       INTEGER ndomain
+>       parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+189a138,141
+>       real znetrad(ndomainsz,nflev) 
+> 
+>       real zfluxd_sw(ndomainsz,nflev+1,2)
+>       real zfluxu_sw(ndomainsz,nflev+1,2)
+191,205d142
+<       REAL netrad(ngrid,nflev) 
+<       REAL fluxd_sw(ngrid,nflev+1,2)
+<       REAL fluxu_sw(ngrid,nflev+1,2)
+< 
+< c     Aerosol size distribution
+<       REAL :: reffrad(ngrid,nlayer,naerkind)
+<       REAL :: nueffrad(ngrid,nlayer,naerkind)
+< c     Aerosol optical properties
+<       REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+<       REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+<       REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+< 
+<       REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+<       REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+<       REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+207,208c144,156
+<       REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+<       REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+---
+>       REAL zplev(ndomainsz,nflev+1)
+>       REAL zztlev(ndomainsz,nflev+1)
+>       REAL zplay(ndomainsz,nflev)
+>       REAL zt(ndomainsz,nflev)
+>       REAL zaerosol(ndomainsz,nflev,naerkind)
+>       REAL zalbedo(ndomainsz,2)
+>       REAL zdp(ndomainsz,nflev)
+>       REAL zdt0(ndomainsz)
+> 
+>       REAL zzdtlw(ndomainsz,nflev)
+>       REAL zzdtsw(ndomainsz,nflev)
+>       REAL zzflux(ndomainsz,6)
+>       real zrmuz
+210,211d157
+<       REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+<       REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+233d178
+< 
+238,253d182
+< 
+< c        Logical tests for radiatively active water-ice clouds:
+<          IF ( (activice.AND.(.NOT.water)).OR.
+<      &        (activice.AND.(naerkind.LT.2)) ) THEN
+<            WRITE(*,*) 'If activice is TRUE, water has to be set'
+<            WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+<            WRITE(*,*) 'equal to 2 in dimradmars.h.'
+<            CALL ABORT
+<          ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+<            WRITE(*,*) 'naerkind is greater than unity, but'
+<            WRITE(*,*) 'activice has not been set to .true.'
+<            WRITE(*,*) 'in callphys.def; this is not logical!'
+<            CALL ABORT
+<          ENDIF
+< 
+< c        Loading the optical properties in external look-up tables:
+256a186,198
+>          write(*,*) 'Splitting radiative calculations: ',
+>      $              ' ngridmx,ngrid,ndomainsz,ndomain',
+>      $                ngridmx,ngrid,ndomainsz,ndomain
+>          if (ngridmx .EQ. 1) then
+>            if (ndomainsz .NE. 1) then
+>              print*
+>              print*,'ATTENTION !!!'
+>              print*,'pour tourner en 1D, '
+>              print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+>              print*
+>              call exit(1)
+>            endif
+>          endif
+260,261c202,203
+< c     Computing aerosol optical properties and opacity
+< c     ------------------------------------------------
+---
+> c     Starting loop on sub-domain
+> c     ----------------------------
+263,279c205,220
+< c     Updating aerosol size distributions:
+<       CALL updatereffrad(ngrid,nlayer,
+<      &                pplev,pplay,
+<      &                rice,nuice,
+<      &                reffrad,nueffrad)
+< 
+< c     Computing 3D scattering parameters:
+<       CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+<      &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+<      &                      QIRsQREF3d,omegaIR3d,gIR3d,
+<      &                      QREFvis3d,QREFir3d,
+<      &                      omegaREFvis3d,omegaREFir3d)
+< 
+< c     Computing aerosol optical depth in each layer:
+<       CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+<      &      tauref,tau,aerosol,reffrad,
+<      &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+---
+>       DO jd=1,ndomain
+>         ig0=(jd-1)*ndomainsz
+>         if (jd.eq.ndomain) then
+>          nd=ngridmx-ig0
+>         else
+>          nd=ndomainsz
+>         endif
+>         
+> 
+> c       Spliting input variable in sub-domain input variables
+> c       ---------------------------------------------------
+>         do l=1,nlaylte+1
+>          do ig = 1,nd
+>           zplev(ig,l) = pplev(ig0+ig,l)
+>          enddo
+>         enddo
+282c223,226
+<          do ig = 1, ngrid
+---
+>          do ig = 1,nd
+>           zplay(ig,l) = pplay(ig0+ig,l)
+>           zt(ig,l) = pt(ig0+ig,l)
+> 
+284c228
+<           dp(ig,l)= pplev(ig,l) - pplev(ig,l+1)
+---
+>           zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+287a232,245
+>         do n=1,naerkind
+>           do l=1,nlaylte
+>             do ig=1,nd
+>               zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+>             enddo
+>           enddo
+>         enddo
+> 
+>         do j=1,2
+>           do ig = 1,nd
+>            zalbedo(ig,j) = albedo(ig0+ig,j)
+>           enddo
+>         enddo
+> 
+291,294c249,252
+<         DO ig=1, ngrid
+<               ptlev(ig,1)=pt(ig,1)+
+<      s        (pplev(ig,1)-pplay(ig,1))*
+<      s        (pt(ig,1)-pt(ig,2))/(pplay(ig,1)-pplay(ig,2))
+---
+>         DO ig=1,nd
+>               zztlev(ig,1)=zt(ig,1)+
+>      s        (zplev(ig,1)-zplay(ig,1))*
+>      s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+296c254
+<               dt0(ig) = tsurf(ig) - ptlev(ig,1)
+---
+>               zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+300,301c258,259
+<          DO ig=1, ngrid
+<                ptlev(ig,l)=0.5*(pt(ig,l-1)+pt(ig,l))
+---
+>          DO ig=1,nd
+>                zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l))
+305,306c263,264
+<         DO ig=1, ngrid
+<            ptlev(ig,nlaylte+1)=pt(ig,nlaylte)
+---
+>         DO ig=1,nd
+>            zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+312,317c270,291
+<         call lwmain (icount,ngrid,nflev
+<      .        ,dp,dt0,emis,pplev,ptlev,pt
+<      .        ,aerosol,dtlw
+<      .        ,fluxsurf_lw,fluxtop_lw
+<      .        ,netrad
+<      &        ,QIRsQREF3d,omegaIR3d,gIR3d)
+---
+> 
+>         !PRINT*,'ig0',ig0
+>         !PRINT*,'icount',icount
+>         !PRINT*,'nd',nd
+>         !PRINT*,'nflev',nflev
+>         !PRINT*,'zdp',zdp
+>         !PRINT*,'zdt0',zdt0
+>         !PRINT*,'emis',emis(ig0+1)
+>         !PRINT*,'zplev',zplev
+>         !PRINT*,'zztlev',zztlev
+>         !PRINT*,'zt',zt
+>         !PRINT*,'zaerosol',zaerosol
+>         !PRINT*,'zzdtlw',zzdtlw
+>         !PRINT*,'fluxsurf_lw',fluxsurf_lw(ig0+1)
+>         !PRINT*,'fluxtop_lw',fluxtop_lw(ig0+1)
+>         !PRINT*,'znetrad',znetrad
+> 
+>         call lwmain (ig0,icount,nd,nflev
+>      .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+>      .        ,zaerosol,zzdtlw
+>      .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+>      .        ,znetrad)
+325,329c299,302
+<            call swmain ( ngrid, nflev, 
+<      S     cste_mars, albedo, 
+<      S     mu0, dp, pplev, aerosol, fract,
+<      S     dtsw, fluxd_sw, fluxu_sw,
+<      &     QVISsQREF3d,omegaVIS3d,gVIS3d)
+---
+>            call swmain ( nd, nflev, 
+>      S     cste_mars, zalbedo, 
+>      S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+>      S     zzdtsw, zfluxd_sw, zfluxu_sw)
+330a304
+> c       Un-spliting output variable from sub-domain input variables
+333,337c307,317
+<         do ig = 1, ngrid
+<           fluxsurf_sw(ig,1) = fluxd_sw(ig,1,1)
+<           fluxsurf_sw(ig,2) = fluxd_sw(ig,1,2)
+<           fluxtop_sw(ig,1) = fluxu_sw(ig,nlaylte+1,1)
+<           fluxtop_sw(ig,2) = fluxu_sw(ig,nlaylte+1,2)
+---
+>         do l=1,nlaylte
+>          do ig = 1,nd
+>           dtlw(ig0+ig,l) = zzdtlw(ig,l)
+>           dtsw(ig0+ig,l) = zzdtsw(ig,l)
+>          enddo
+>         enddo
+> 
+>         do l=1,nlaylte+1
+>          do ig = 1,nd
+>           ptlev(ig0+ig,l) = zztlev(ig,l)
+>          enddo
+339a320,330
+>         do ig = 1,nd
+>           fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+>           fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+>           fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+>           fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+>         enddo
+> 
+> 
+>       ENDDO         !   (boucle jd=1, ndomain)
+> 
+> 
+348a340
+>         
+28,32c28,31
+<       INTEGER ngrid              ! number of horizontal grid points
+<       INTEGER nlay               ! number of atmospheric layers
+<       REAL ptimestep             ! physics time step (s)
+<       REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+<       REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+---
+>       INTEGER ngrid,nlay
+>       REAL ptimestep             ! pas de temps physique (s)
+>       REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+>       REAL pt(ngrid,nlay)        ! temperature au centre des couches (K)
+37,41c36,40
+<       integer nq                 ! number of tracers
+<       real pq(ngrid,nlay,nq)     ! tracer (kg/kg)
+<       real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+<       real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+<       real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+---
+>       integer nq                 ! nombre de traceurs
+>       real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
+>       real pdqfi(ngrid,nlay,nq)  ! tendance avant sedimentation (kg/kg.s-1)
+>       real pdqsed(ngrid,nlay,nq) ! tendande due a la sedimentation (kg/kg.s-1)
+>       real pdqs_sed(ngrid,nq)    ! flux en surface (kg.m-2.s-1)
+54c53
+<       real zq(ngridmx,nlayermx,2) ! to locally store dust tracers
+---
+>       real zq(ngridmx,nlayermx,2)
+86,89c85,86
+<       INTEGER idust_mass   ! index of tracer containing dust mass mix. ratio
+<       INTEGER idust_number ! index of tracer containing dust number mix. ratio
+<       INTEGER niq(2)       ! to store the indexes corresponding to dust
+<       SAVE idust_mass,idust_number,niq
+---
+> 
+> 
+123,147c120
+< 
+<       ! identify tracers corresponding to mass mixing ratio and
+<       ! number mixing ratio
+<         idust_mass=0      ! dummy initialization
+<         idust_number=0    ! dummy initialization
+<         
+<         do iq=1,nq
+<           if (noms(iq).eq."dust_mass") then
+<             idust_mass=iq
+<             niq(1)=idust_mass
+<           endif
+<           if (noms(iq).eq."dust_number") then
+<             idust_number=iq
+<             niq(2)=idust_number
+<           endif
+<         enddo
+<         
+<         ! check that we did find the tracers
+<         if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
+<           write(*,*) 'callsedim2q: error! could not identify tracers'
+<           write(*,*) '         for dust mass and number mixing ratio' 
+<           stop
+<         endif
+<         
+<       ENDIF ! of IF (firstcall)
+---
+>       ENDIF
+162,169c135
+<             zq(ig,l,iq)=pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep
+< ! unrolling loop in iq would amount to:
+<             ! dust mass mixing ratio
+< !            zq(ig,l,1)=pq(ig,l,idust_mass)
+< !     &                     +pdqfi(ig,l,idust_mass)*ptimestep
+<             ! dust number mixing ratio
+< !            zq(ig,l,2)=pq(ig,l,idust_number)
+< !     &                     +pdqfi(ig,l,idust_number)*ptimestep
+---
+>             zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+245c211
+<           call zerophys(ngridmx*nlayermx,pdqs_sed(1,niq(iq)))
+---
+>           call zerophys(ngridmx*nlayermx,pdqs_sed(1,iq))
+257,258c223
+<                pdqs_sed(ig,niq(iq)) = pdqs_sed(ig,niq(iq))
+<      &                                + wq(ig,1)/ptimestep
+---
+>                pdqs_sed(ig,iq) = pdqs_sed(ig,iq) + wq(ig,1)/ptimestep
+270c235
+<           enddo ! of do ir=1,nr
+---
+>           enddo
+274,276c239,240
+<               pdqsed(ig,l,niq(iq))=(zq(ig,l,iq)-
+<      $             (pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep)
+<      &                              )/ptimestep
+---
+>               pdqsed(ig,l,iq)=(zq(ig,l,iq)-
+>      $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+2c2
+<      $                pplev,zlev, pt, rnuclei, rice,
+---
+>      $                pplev,zlev, pt,
+23a24
+> #include "fisice.h"
+28,36c29,34
+<       INTEGER ngrid              ! number of horizontal grid points
+<       INTEGER nlay               ! number of atmospheric layers
+<       REAL ptimestep             ! physics time step (s)
+<       REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+<       REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+<       REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+< c    Aerosol radius provided by the water ice microphysical scheme:
+<       REAL rnuclei(ngrid,nlay)   ! Prescribed dust radius in each layer (m)
+<       REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+---
+>       INTEGER ngrid,nlay
+>       REAL ptimestep            ! pas de temps physique (s)
+>       REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+>       REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+>       REAL zlev(ngrid,nlay+1) ! altitude at layer boundaries
+> 
+39,43c37,41
+<       integer nq             ! number of tracers
+<       real pq(ngrid,nlay,nq)  ! tracers (kg/kg)
+<       real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+<       real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+<       real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+---
+>       integer nq             ! nombre de traceurs
+>       real pq(ngrid,nlay,nq)  ! traceur (kg/kg)
+>       real pdqfi(ngrid,nlay,nq)  ! tendance avant sedimentation (kg/kg.s-1)
+>       real pdqsed(ngrid,nlay,nq) ! tendande due a la sedimentation (kg/kg.s-1)
+>       real pdqs_sed(ngrid,nq)    ! flux en surface (kg.m-2.s-1)
+50,53c48,51
+<       real zqi(ngridmx,nlayermx) ! to locally store tracers
+<       real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
+<       real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
+<       real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
+---
+>       real zqi(ngridmx,nlayermx)
+>       real masse (ngridmx,nlayermx)
+>       real epaisseur (ngridmx,nlayermx)
+>       real wq(ngridmx,nlayermx+1) 
+67c65
+<             PRINT*,'STOP dans callsedim'
+---
+>             PRINT*,'STOP dans coefdifv'
+73,75c71,72
+<       
+<         firstcall=.false.
+<       ENDIF ! of IF (firstcall)
+---
+>          firstcall=.false.
+>       ENDIF
+93c90,91
+<       do iq=1,nq
+---
+>       do iq=1, nq
+> 
+101d98
+<               ! store locally updated tracers
+103,104c100
+< !              if (iceparty.and.iq.eq.nq-1) then
+<               if (water.and.(iq.eq.igcm_h2o_ice)) then
+---
+>               if (iceparty.and.iq.eq.nq-1) then
+108c104
+<                 rfall(ig,l)=max( rice(ig,l)*1.5,rnuclei(ig,l) )
+---
+>                 rfall(ig,l)=max( rice(ig,l)*1.5,rdust(ig,l) )
+111a108
+>                 
+114c111
+<           enddo ! of do l=1,nlay
+---
+>           enddo
+118,119c115
+< !          if(iceparty.and.iq.eq.nq-1) then
+<           if (water.and.(iq.eq.igcm_h2o_ice)) then
+---
+>           if(iceparty.and.iq.eq.nq-1) then
+121c117
+<      &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi,wq)
+---
+>      &      pplev,masse,epaisseur,pt,rfall,rho_ice,zqi,wq)
+124c120
+<      &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),zqi,wq)
+---
+>      &      pplev,masse,epaisseur,pt,radius(iq),rho_dust,zqi,wq)
+130,142c126,130
+< !            if(iceparty.and.iq.eq.nq-1) then
+< !                pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+< !            else
+< !                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+< !            endif
+< ! Temporary: surface ice is qsurf(igcm_h2o_vap) ! no more
+< !            if(iceparty.and.(iq.eq.igcm_h2o_ice)) then
+< !                pdqs_sed(ig,igcm_h2o_vap) = wq(ig,1)/ptimestep 
+< !            else
+< !                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+< !            endif
+< ! Ehouarn: with new way of tracking tracers by name, it should now simply be
+<             pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+---
+>             if(iceparty.and.iq.eq.nq-1) then
+>                 pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+>             else
+>                 pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+>             endif
+144d131
+< 
+152,154c139,140
+< 
+<         endif ! of if(radius(iq).gt.1.e-9)
+<       enddo ! of do iq=1,nq
+---
+>         endif
+>       enddo
+1c1,2
+<       SUBROUTINE co2snow (ngrid,nlayer,ptimestep,emisref,condsub,pplev,
+---
+>       SUBROUTINE co2snow (ngrid,nlayer,ptimestep,
+>      &          emisref,condsub,pplev,
+5a7,9
+> 
+> c*****WRF: ligne trop longue
+> 
+1,2c1,2
+< !-----------------------------------------------------------------------
+< ! INCLUDE "comcstfi.h"
+---
+> c-----------------------------------------------------------------------
+> c INCLUDE comcstfi.h
+4c4,5
+<       common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+---
+>       COMMON/comcstfi/
+>      * pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+6c7
+<       real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+---
+>       REAL pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+57c57
+<       REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+---
+>       REAL zhm,zsm,zum,zvm,zalpha,zhmc
+70,71c70
+<       real mtot1, mtot2 , mm1, mm2
+<        integer l1ref, l2ref
+---
+> 
+91a91
+> c           write(*,*) "convadj: nqmx=",nqmx
+92a93
+> c           write(*,*) "convadj: iq=",iq," noms(iq)=",noms(iq)
+95,96c96,97
+<                 m_co2 = 44.01E-3  ! CO2 molecular mass (kg/mol)   
+<                 m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/mol)   
+---
+>                 m_co2 = 44.01E-3  ! CO2 molecular mass (kg/m-3)   
+>                 m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/m-3)   
+104a106
+>            firstcall=.false.
+106,107c108
+<         firstcall=.false.
+<       ENDIF ! of IF (firstcall)
+---
+>       ENDIF
+151a153
+> c         write(*,*) "convadj: ico2=",ico2," nqmx=",nqmx
+168a171
+> CRAY  CALL WHENNE(ngrid, vtest, 1, 0, jadrs, jcnt)
+182c185
+<       DO jj = 1, jcnt   ! loop on every convective grid point
+---
+>       DO jj = 1, jcnt
+185c188
+<  
+---
+> c
+189d191
+<         
+199c201
+< cins$     Loop  vers le haut sur l2
+---
+> cins$     Loop
+202a205,206
+> c
+> cins$       Exit
+203a208
+> c
+205c210
+<  
+---
+> c
+207c212
+<  
+---
+> c
+211d215
+<               zdsm = dsig(l2)
+216c220,221
+< c             Loop
+---
+> c
+> cins$         Loop
+220d224
+<                 zdsm = zdsm + dsig(l)
+224c228
+<      &            zqco2m + dsig(l) * (zq2(i,l,ico2) - zqco2m) / zdsm
+---
+>      &            zqco2m + sdsig(l) * (zq2(i,l,ico2) - zqco2m) / zsm
+229c233
+<  
+---
+> c
+231c235,237
+<  
+---
+> c
+> c_EC (M1875) 20/6/87 : AND -> AND THEN
+> c
+238c244
+<  
+---
+> c
+240c246
+<  
+---
+> c
+243c249
+<  
+---
+> c
+245c251
+<  
+---
+> c
+247c253,254
+<  
+---
+> c
+> cins$             Exit
+249c256,257
+<  
+---
+> c
+> cins$             Exit
+289a298,299
+> c                PRINT*,'WARNING dans convadj zalpha=',zalpha
+> c         STOP
+300,301c310,311
+< c                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+<                    zq2(i,l,iq)=zqm(iq)
+---
+>                    zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+> c                  zq2(i,l,iq)=zqm(iq)
+305,310d314
+<               if (ico2.ne.0) then
+<                 DO l=l1, l2
+<                   zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+<                 ENDDO
+<               end if
+< 
+314,316c318,321
+<             END IF   ! fin traitement instabilité entre l1 et l2. 
+< c                      On repart pour test à partir du l2 au dessus...
+<           ENDDO   ! End Loop sur l2 vers le haut 
+---
+>             END IF
+> c
+> cins$     End Loop
+>           ENDDO
+324a330,332
+> c         pdhadj(ig,l)=0.
+> c         pduadj(ig,l)=0.
+> c         pdvadj(ig,l)=0.
+337,348d344
+< 
+< c     outpu
+<       if (ngrid.eq.1) then
+<          ig=1
+<          iq =1 
+<          write(*,*)'**** l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+<          do l=nlay,1,-1
+<            write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+<          end do
+<       end if
+< 
+< 
+1,10c1
+< subroutine def_var(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+< 
+< ! This subroutine defines variable 'name' in a (pre-existing and opened)
+< ! NetCDF file (known from its NetCDF ID 'nid').
+< ! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+< ! corresponding dimensions must be set (in array 'dimids').
+< ! Upon successfull definition of the variable, 'nvarid' contains the
+< ! NetCDF ID of the variable.
+< ! The variables' attributes 'title' (Note that 'long_name' would be more
+< ! appropriate) and 'units' are also set. 
+---
+> subroutine def_var(nid,name,title,units,nbdim,dim,nvarid,ierr)
+14c5
+< #include "netcdf.inc"
+---
+> include "netcdf.inc"
+16,24c7,9
+< integer,intent(in) :: nid ! NetCDF file ID
+< character(len=*),intent(in) :: name ! the variable's name
+< character(len=*),intent(in) :: title ! 'title' attribute of variable
+< character(len=*),intent(in) :: units ! 'units' attribute of variable
+< integer,intent(in) :: nbdim ! number of dimensions of the variable
+< integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+<                                               ! the variable is defined along
+< integer,intent(out) :: nvarid ! NetCDF ID of the variable
+< integer,intent(out) :: ierr ! returned NetCDF staus code
+---
+> character (len=*) :: title,units,name
+> integer :: nid,nbdim,nvarid,ierr
+> integer, dimension(nbdim) :: dim
+26d10
+< ! 1. Switch to NetCDF define mode 
+28,29d11
+< 
+< ! 2. Define the variable
+31c13
+< ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+---
+> ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid)
+33c15
+< ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+---
+> ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid)
+36d17
+<    write(*,*) "def_var: Failed defining variable "//trim(name)
+38c19
+<    stop ""
+---
+>    stop "in def_var"
+40,43c21
+< 
+< ! 3. Write attributes
+< ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+<                      len_trim(adjustl(title)),adjustl(title))
+---
+> ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title))
+45d22
+<    write(*,*) "def_var: Failed writing title attribute for "//trim(name)
+47c24
+<    stop ""
+---
+>    stop "in def_var"
+49,51c26
+< 
+< ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+<                      len_trim(adjustl(units)),adjustl(units))
+---
+> ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units))
+53d27
+<    write(*,*) "def_var: Failed writing units attribute for "//trim(name)
+55c29
+<    stop ""
+---
+>    stop "in def_var"
+57,58d30
+< 
+< ! 4. Switch out of NetCDF define mode
+4,11c4,10
+< ! ngridmx : number of horizontal grid points
+< ! note: the -1/jjm term will be 0; unless jj=1
+<       integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
+< ! nlayermx : number of atmospheric layers
+<       integer, parameter :: nlayermx = llm 
+< ! nsoilmx : number of subterranean layers
+< !EM: old soil routine:      integer, parameter :: nsoilmx = 10
+<       integer, parameter :: nsoilmx = 18 
+---
+> 
+>          INTEGER, parameter :: wiim=44
+>          INTEGER, parameter :: wjjm=44
+>          INTEGER, PARAMETER :: ngridmx=1936
+>          INTEGER, parameter :: nlayermx=70
+>          INTEGER, PARAMETER :: nsoilmx=10
+> 	
+12a12,13
+> 
+> 	 
+1,3c1,21
+< ! ----------------------------------------------------------------------
+< ! -----------------------------------------------------------------------
+< !   INCLUDE 'dimradmars.h'
+---
+> c-----------------------------------------------------------------------
+> c------------------------------------------------------------------------
+> c   INCLUDE 'dimradmars.h'
+> 
+> c   Declaration and initialisation or radiative transfer calculations
+> c------------------------------------------------------------------------
+> c------------------------------------------------------------------------
+> 
+> c Splitting of horizontal grid (to reduce program size on workstation)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c nflev: number of vertical layer
+> c ndlon: nombre de points de la grille horizontale
+> c NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+> c ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
+> 
+>       INTEGER  NFLEV,NDLON, ndomainsz, NDLO2
+> 
+> c        parameter (ndomainsz=ngridmx)
+> cc       parameter (ndomainsz=(ngridmx-1)/20 + 1)
+> cc      parameter (ndomainsz=(ngridmx-1)/5 + 1)
+>         parameter (ndomainsz=(ngridmx-1)/100 + 1)
+5,14c23,24
+< !   Declaration and initialisation or radiative transfer calculations
+< !------------------------------------------------------------------------
+< !------------------------------------------------------------------------
+< 
+< ! nflev: number of vertical layer
+< ! ndlon,ndlo2: number of horizontal points
+< 
+<       INTEGER  NFLEV,NDLON,NDLO2
+< 
+<       parameter (NFLEV=nlayermx,NDLON=ngridmx)
+---
+> 	
+>       parameter (NFLEV=nlayermx,NDLON=ndomainsz)	! avec decoupage 
+17,22d26
+< ! Number of kind of tracer radiative properties 
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! (ex: naerkind=1 if you use one dust mode without ice ...)
+< ! (ex: naerkind=2 if you use one dust mode and active ice ...)
+<       integer naerkind
+<       parameter (naerkind=1)
+24,27c28
+< ! Reference wavelengths used to compute reference optical depth (m)
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< 
+<       REAL longrefir(naerkind),longrefvis(naerkind)
+---
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+28a30
+>       REAL longrefir,longrefvis
+36,37c38,39
+< ! Definition of spectral intervals at thermal infrared wavelengths (LW)
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c Definition of spectral intervals at thermal infrared wavelengths (LW)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+43,47c45,49
+< !  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+< !      iir=1 : central 15um CO2 bands \    
+< !      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+< !      iir=3 : 9 um band [long1ir - long1co2]
+< !      iir=4 : Far IR    [long2co2 - long2ir]
+---
+> c  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+> c      iir=1 : central 15um CO2 bands \    
+> c      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+> c      iir=3 : 9 um band [long1ir - long1co2]
+> c      iir=4 : Far IR    [long2co2 - long2ir]
+49,50c51,52
+< !  Definition of spectral interval at solar wavelengths (SW)
+< !  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c  Definition of spectral interval at solar wavelengths (SW)
+> c  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+52c54
+< !  Boundaries of spectral intervals (m) : 
+---
+> c  Boundaries of spectral intervals (m) : 
+54c56
+< !  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+---
+> c  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+56c58
+< !  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+---
+> c  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+59,77c61,76
+< ! Maximum number of grain size classes
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! This parameter has to be set to the maximum number of particle
+< !   sizes contained in the optical parameter database; For example,
+< !   if only one grain size is used to describe dust, and 30 are used
+< !   to describe water-ice crystals in the visible and 15 in the IR,
+< !   nsizemax has to be set to 30.
+< ! If only one grain size is considered for all the aerosols, set
+< !   this parameter to 1 and convolution will be turned off during
+< !   the radiative calculations.
+< 
+< !     INTEGER, PARAMETER :: nsizemax = 60
+<       INTEGER, PARAMETER :: nsizemax = 1
+< 
+< ! Various initialisation for LW radiative code
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! npademx : nombre de coef de pade 
+< ! nabsmx : ?
+< ! nt_pademx : nombre d'intervalles de temperature pour pade
+---
+> c Reference wavelengths used to compute reference dust optical depth (m)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+>       PARAMETER (longrefir=9.E-6,longrefvis=0.67E-6)
+> 
+> c Number of kind of tracer radiative properties 
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c (ex: naerkind=1 if you use one dust mode without ice ...)
+> c (ex: naerkind=2 if you use one dust mode and active ice ...)
+>       integer naerkind        
+>       parameter (naerkind=1)
+> 
+> c Various initialisation for LW radiative code
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c npademx : nombre de coef de pade 
+> c nabsmx : ?
+> c nt_pademx : nombre d'intervalles de temperature pour pade
+145a146
+> c----------------sursis g95
+151a153,155
+> c----------------problem g95
+> 
+> 
+44c44,67
+<       DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+---
+> 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
+> 
+> 
+> 
+74a98
+> 
+84a109,118
+> 
+> cc       write(*,*) 'caca', us, ust
+> cc       do iq=1,nq
+> cc       do ig=1,ngrid
+> cc          write(*,*) 'cacao', -alpha_lift(iq) * fhoriz(ig)
+> cc       enddo
+> cc       enddo
+> 
+> 
+> 
+93d126
+< 
+2a3,4
+> cccc  subroutine eofdump(cols,rows,nlayer,u,v,t,p)
+> 
+7d8
+< c     Corrected small bug in sampling rate/count, EM 11/2007
+12a14,15
+> c._.  integer cols
+> c._.  integer rows
+42,45c45,46
+< !      write(*,*)'eofdump:count=',count,' ps(1)=',ps(1)
+< !      if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then
+<       if (mod(count+1,ieofs).eq.0) then
+< !        write(*,*)'eofdump: dump --> ps(1)=',ps(1)
+---
+>       if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then
+> 
+7,8c7,8
+< c   Initialization related to tracer 
+< c   (transported dust, water, chemical species, ice...)
+---
+> c   Initialisation related to tracer 
+> c (transported dust, water, chemical species, ice...)
+13,16c13
+< c   Initialize COMMON tracer in tracer.h, using tracer names provided
+< c   by the dynamics in "advtrac.h"
+< c
+< c   Old conventions: (not used any more)
+---
+> c   Initialise COMMON tracer in tracer.h
+19c16
+< c     and q(iq=nqmx-1) is the ice mass mixing ratio
+---
+> c   If water=T and iceparty=T : q(iq=nqmx-1) is the ice mass mixing ratio
+34c31
+< c            Ehouarn Millour (oct. 2008) identify tracers by their names
+---
+> c
+43c40
+< #include "advtrac.h"
+---
+> 
+45a43,44
+> #include "aerice.h"
+> #include "fisice.h"
+51c50
+<       integer iq,ig,count
+---
+>       integer iq,ig
+53,54d51
+<       logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+<       character(len=20) :: txt ! to store some text
+58d54
+< c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+68d63
+<       integer :: nqchem_start
+70,156d64
+< ! Initialization: get tracer names from the dynamics and check if we are
+< !                 using 'old' tracer convention ('q01',q02',...)
+< !                 or new convention (full tracer names)
+<       ! check if tracers have 'old' names
+<       oldnames=.false.
+<       count=0
+<       do iq=1,nqmx
+<         txt=" "
+<         write(txt,'(a1,i2.2)') 'q',iq
+<         if (txt.eq.tnom(iq)) then
+<           count=count+1
+<         endif
+<       enddo ! of do iq=1,nqmx
+<       
+<       if (count.eq.nqmx) then
+<         write(*,*) "initracer: tracers seem to follow old naming ",
+<      &             "convention (q01,q02,...)"
+<         write(*,*) "   => will work for now ... "
+<         write(*,*) "      but you should run newstart to rename them"
+<         oldnames=.true.
+<       endif
+< 
+<       ! copy/set tracer names
+<       if (oldnames) then ! old names (derived from iq & option values)
+<         ! 1. dust:
+<         if (dustbin.ne.0) then ! transported dust
+<           do iq=1,dustbin
+<             txt=" "
+<             write(txt,'(a4,i2.2)') 'dust',iq
+<             noms(iq)=txt
+<             mmol(iq)=100.
+<           enddo
+<           ! special case if doubleq
+<           if (doubleq) then
+<             if (dustbin.ne.2) then
+<               write(*,*) 'initracer: error expected dustbin=2'
+<             else
+<               noms(1)='dust_mass'   ! dust mass mixing ratio
+<               noms(2)='dust_number' ! dust number mixing ratio
+<             endif
+<           endif
+<         endif
+<         ! 2. water & ice
+<         if (water) then
+<           noms(nqmx)='h2o_vap'
+<           mmol(nqmx)=18.
+<           noms(nqmx-1)='h2o_ice'
+<           mmol(nqmx-1)=18.
+<         endif
+<         ! 3. Chemistry
+<         if (photochem .or. callthermos) then
+<           if (doubleq) then
+<             nqchem_start=3
+<           else
+<             nqchem_start=dustbin+1
+<           end if
+<           do iq=nqchem_start,nqchem_start+ncomp-1
+<             noms(iq)=nomchem(iq-nqchem_start+1)
+<             mmol(iq)=mmolchem(iq-nqchem_start+1)
+<           enddo
+<         endif ! of if (photochem .or. callthermos)
+<         ! 4. Other tracers ????
+<         if ((dustbin.eq.0).and.(.not.water)) then
+<           noms(1)='co2'
+<           mmol(1)=44
+<           if (nqmx.eq.2) then
+<             noms(nqmx)='Ar_N2'
+<             mmol(nqmx)=30
+<           endif
+<         endif
+<       else
+<         ! copy tracer names from dynamics
+<         do iq=1,nqmx
+<           noms(iq)=tnom(iq)
+<         enddo
+<         ! mmol(:) array is initialized later (see below)
+<       endif ! of if (oldnames)
+< 
+<       ! special modification when using 'old' tracers:
+<       ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
+<       ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
+<       if (oldnames.and.water) then
+<         write(*,*)'initracer: moving surface water ice to index ',nqmx-1
+<         qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx)
+<         qsurf(1:ngridmx,nqmx)=0
+<       endif 
+<       
+162,165c70,73
+<           if (water) then
+<               if ((dustbin+ncomp+2).ne.nqmx) then
+<                  print*,'initracer: tracer dimension problem:'
+<                  print*,"(dustbin+ncomp+2).ne.nqmx"
+---
+>           if (iceparty) then
+>               if ((nqchem_min+ncomp+1).ne.nqmx) then
+>                  print*,'********* Dimension problem! ********'
+>                  print*,"nqchem_min+ncomp+1).ne.nqmx"
+167c75
+<                  print*,"dustbin: ",dustbin
+---
+>                  print*,"nqchem_min: ",nqchem_min
+172,174c80,82
+<               if ((dustbin+ncomp+1).ne.nqmx) then
+<                  print*,'initracer: tracer dimension problem:'
+<                  print*,"(dustbin+ncomp+1).ne.nqmx"
+---
+>                if ((nqchem_min+ncomp).ne.nqmx) then
+>                  print*,'********* Dimension problem! ********'
+>                  print*,"nqchem_min+ncomp).ne.nqmx"
+176c84
+<                  print*,"dustbin: ",dustbin
+---
+>                  print*,"nqchem_min: ",nqchem_min
+182c90
+<       endif
+---
+>           endif
+188,337c96,120
+<    
+< ! Identify tracers by their names: (and set corresponding values of mmol)
+<       ! 0. initialize tracer indexes to zero:
+<       do iq=1,nqmx
+<         igcm_dustbin(iq)=0
+<       enddo
+<       igcm_dust_mass=0
+<       igcm_dust_number=0
+<       igcm_h2o_vap=0
+<       igcm_h2o_ice=0
+<       igcm_co2=0
+<       igcm_co=0
+<       igcm_o=0
+<       igcm_o1d=0
+<       igcm_o2=0
+<       igcm_o3=0
+<       igcm_h=0
+<       igcm_h2=0
+<       igcm_oh=0
+<       igcm_ho2=0
+<       igcm_h2o2=0
+<       igcm_n2=0
+<       igcm_ar=0
+<       igcm_ar_n2=0
+< 
+<       ! 1. find dust tracers
+<       count=0
+<       if (dustbin.gt.0) then
+<         do iq=1,nqmx
+<           txt=" "
+<           write(txt,'(a4,i2.2)')'dust',count+1
+<           if (noms(iq).eq.txt) then
+<             count=count+1
+<             igcm_dustbin(count)=iq
+<             mmol(iq)=100.
+<           endif
+<         enddo !do iq=1,nqmx
+<       endif ! of if (dustbin.gt.0)
+<       if (doubleq) then
+<         do iq=1,nqmx
+<           if (noms(iq).eq."dust_mass") then
+<             igcm_dust_mass=iq
+<             count=count+1
+<           endif
+<           if (noms(iq).eq."dust_number") then
+<             igcm_dust_number=iq
+<             count=count+1
+<           endif
+<         enddo
+<       endif ! of if (doubleq)
+<       ! 2. find chemistry and water tracers
+<       do iq=1,nqmx
+<         if (noms(iq).eq."co2") then
+<           igcm_co2=iq
+<           mmol(igcm_co2)=44.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."co") then
+<           igcm_co=iq
+<           mmol(igcm_co)=28.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."o") then
+<           igcm_o=iq
+<           mmol(igcm_o)=16.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."o1d") then
+<           igcm_o1d=iq
+<           mmol(igcm_o1d)=16.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."o2") then
+<           igcm_o2=iq
+<           mmol(igcm_o2)=32.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."o3") then
+<           igcm_o3=iq
+<           mmol(igcm_o3)=48.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."h") then
+<           igcm_h=iq
+<           mmol(igcm_h)=1.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."h2") then
+<           igcm_h2=iq
+<           mmol(igcm_h2)=2.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."oh") then
+<           igcm_oh=iq
+<           mmol(igcm_oh)=17.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."ho2") then
+<           igcm_ho2=iq
+<           mmol(igcm_ho2)=33.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."h2o2") then
+<           igcm_h2o2=iq
+<           mmol(igcm_h2o2)=34.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."n2") then
+<           igcm_n2=iq
+<           mmol(igcm_n2)=28.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."ar") then
+<           igcm_ar=iq
+<           mmol(igcm_ar)=40.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."h2o_vap") then
+<           igcm_h2o_vap=iq
+<           mmol(igcm_h2o_vap)=18.
+<           count=count+1
+<         endif
+<         if (noms(iq).eq."h2o_ice") then
+<           igcm_h2o_ice=iq
+<           mmol(igcm_h2o_ice)=18.
+<           count=count+1
+<         endif
+<         ! Other stuff: e.g. for simulations using co2 + neutral gaz
+<         if (noms(iq).eq."Ar_N2") then
+<           igcm_ar_n2=iq
+<           mmol(igcm_ar_n2)=30.
+<           count=count+1
+<         endif
+<       enddo ! of do iq=1,nqmx
+< !      count=count+nbqchem
+<       
+<       ! check that we identified all tracers:
+<       if (count.ne.nqmx) then
+<         write(*,*) "initracer: found only ",count," tracers"
+<         write(*,*) "               expected ",nqmx
+<         do iq=1,count
+<           write(*,*)'      ',iq,' ',trim(noms(iq))
+<         enddo
+<         stop
+<       else
+<         write(*,*) "initracer: found all expected tracers, namely:"
+<         do iq=1,nqmx
+<           write(*,*)'      ',iq,' ',trim(noms(iq))
+<         enddo
+<       endif
+---
+> c noms and mmol vectors:
+>       if (water) then 
+>          mmol(nqmx) = 18.
+>          noms(nqmx)   = 'h2o'
+>       end if
+>       if (iceparty) then
+>          noms(nqmx-1) = 'ice'
+>          mmol(nqmx-1) = 18.
+>       end if
+>       if(photochem.or.thermochem) then
+>          do iq=nqchem_min, nqchem_min+ncomp-1
+>              noms(iq) = nomchem(iq-nqchem_min+1)
+>              mmol(iq) = mmolchem(iq-nqchem_min+1)
+>          enddo
+>       end if
+>       if (dustbin.ge.1) then
+>           do iq=1,dustbin
+>             noms(iq) = 'dust'
+>             mmol(iq) = 100.
+>           enddo
+>           if (doubleq) then
+>            noms(1) = 'dust mass mix. ratio'
+>            noms(dustbin) = 'dust number mix. ratio'
+>           end if
+>       end if
+339,350c122,131
+<       ! if water cycle but iceparty=.false., there will nevertheless be
+<       ! water ice at the surface (iceparty is not used anymore, but this
+<       ! part is still relevant, as we want to stay compatible with the
+<       ! older versions).
+<       if (water.and.(igcm_h2o_ice.eq.0)) then
+<         igcm_h2o_ice=igcm_h2o_vap ! so that qsurf(i_h2o_ice) is identified
+<                                   ! even though there is no q(i_h2o_ice)
+<       else
+<        ! surface ice qsurf(i_h2o_ice) was loaded twice by phyetat0,
+<        ! as qsurf(i_h2o_vap) & as qsurf(i_h2o_ice), so to be clean:
+<        qsurf(1:ngridmx,igcm_h2o_vap)=0
+<       endif
+---
+> c     Simulation of CO2 + neutral gaz
+>       if ((dustbin.eq.0).and.(.not.water)) then
+>          noms(1) = 'co2'
+>          mmol(1) = 44
+>          if (nqmx.eq.2)then
+>             noms(nqmx) = 'Ar_N2'
+>             mmol(nqmx) = 30
+>          end if 
+>       end if 
+>    
+355d135
+<       call zerophys(nqmx,rho_q)
+367,368c147,148
+<           write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+<           write(*,*)'water= ',water,' doubleq= ',doubleq   
+---
+>             write(*,*) 'nqmx is too low : nqmx=', nqmx
+>             write(*,*) 'water= ',water,' doubleq= ',doubleq   
+372,375c152,153
+<         qext(igcm_dust_mass)=3.04   ! reference extinction at 0.67 um for ref dust
+<         qext(igcm_dust_number)=3.04 ! reference extinction at 0.67 um for ref dust
+<         rho_q(igcm_dust_mass)=rho_dust
+<         rho_q(igcm_dust_number)=rho_dust
+---
+>         qext(1)=3.04    ! reference extinction at 0.67 um for ref dust
+>         qext(2)=3.04    ! reference extinction at 0.67 um for ref dust
+390,391c168,169
+<         alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+<         alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+---
+>         alpha_devil(1)=9.e-9   !  dust devil lift mass coeff
+>         alpha_lift(1)=3.0e-15  !  Lifted mass coeff
+394,397c172,173
+<         alpha_devil(igcm_dust_number)=r3n_q*
+<      &                        alpha_devil(igcm_dust_mass)/r0_lift**3
+<         alpha_lift(igcm_dust_number)=r3n_q*
+<      &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+---
+>         alpha_devil(2)= r3n_q * alpha_devil(1)/r0_lift**3
+>         alpha_lift(2)= r3n_q * alpha_lift(1)/r0_lift**3
+400,401c176,177
+<         radius(igcm_dust_mass) = 0.
+<         radius(igcm_dust_number) = 0.
+---
+>         radius(1) = 0.
+> 	radius(2) = 0.
+408c184
+<         stop
+---
+> 	stop
+414,420c190,198
+<         radius(igcm_dustbin(1))=3.e-6
+<         Qext(igcm_dustbin(1))=3.04
+<         alpha_lift(igcm_dustbin(1))=0.0e-6
+<         alpha_devil(igcm_dustbin(1))=7.65e-9
+<         qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+<      &                         /(rho_dust*radius(igcm_dustbin(1)))
+<         rho_q(igcm_dustbin(1))=rho_dust
+---
+> cc        radius(1)=3.e-6
+> cc        Qext(1)=3.04
+> cc        alpha_lift(1)=0.0e-6
+> cc        alpha_devil(1)=7.65e-9
+>         radius(1)=1.e-6
+>         Qext(1)=3.04        
+>         alpha_lift(1)=1.
+>         alpha_devil(1)=0.0e-9        
+> 	qextrhor(1)= (3./4.)*Qext(1) / (rho_dust*radius(1))
+428,439c206,212
+<       ! initialize chemistry+water (water will be correctly initialized below)
+<       ! by initializing everything which is not dust ...
+<         do iq=1,nqmx
+<           txt=noms(iq)
+<           if (txt(1:4).ne."dust") then
+<             radius(iq)=0.
+<             Qext(iq)=0.
+<             alpha_lift(iq) =0.
+<             alpha_devil(iq)=0.
+< 	    qextrhor(iq)= 0.
+<           endif
+<         enddo ! do iq=1,nqmx
+---
+>         do iq=nqchem_min,nqmx
+> 	 radius(iq)=0.
+>          Qext(iq)=0.
+>          alpha_lift(iq) =0.
+>          alpha_devil(iq)=0.
+> 	 qextrhor(iq)= 0.
+>         enddo
+445,449c218,222
+<          radius(igcm_h2o_vap)=0.
+<          Qext(igcm_h2o_vap)=0.
+<          alpha_lift(igcm_h2o_vap) =0.
+<          alpha_devil(igcm_h2o_vap)=0.
+< 	 qextrhor(igcm_h2o_vap)= 0.
+---
+>          radius(nqmx)=0.
+>          Qext(nqmx)=0.
+>          alpha_lift(nqmx) =0.
+>          alpha_devil(nqmx)=0.
+> 	 qextrhor(nqmx)= 0.
+460a234
+>            if (activice) pclc(ig)=1.
+465a240
+> c Cloud area fraction (pclc) is defined here.
+469a245,249
+>              if (activice)then
+>                pclc(ig)=1.
+>                print*,'Cloud area ratio : ',pclc(ig),' at lat '
+>      $        ,lati(ig)*180./pi
+>              endif
+472a253
+> c	        pclc(ig)=.3
+473a255
+> c               print*,'Cloud area ratio : ',pclc(ig),' at lat '
+477a260,261
+> c	        pclc(ig)=.3
+> c               print*,'Cloud area ratio : ',pclc(ig),' at lat '
+483,491c267,278
+<          if(water.and.(nqmx.ge.2)) then
+<            radius(igcm_h2o_ice)=3.e-6
+<            rho_q(igcm_h2o_ice)=rho_ice
+<            Qext(igcm_h2o_ice)=0.
+<            alpha_lift(igcm_h2o_ice) =0.
+<            alpha_devil(igcm_h2o_ice)=0.
+<            qextrhor(igcm_h2o_ice)= (3./4.)*Qext(igcm_h2o_ice) 
+<      $       / (rho_ice*radius(igcm_h2o_ice))
+<          elseif(water.and.(nqmx.lt.2)) then
+---
+>          if(iceparty.and.nqmx.ge.2) then
+>            radius(nqmx-1)=3.e-6
+>            Qext(nqmx-1)=0.
+>            alpha_lift(nqmx-1) =0.
+>            alpha_devil(nqmx-1)=0.
+>            if (activice) then
+>              radius(nqmx-1)=rcrystal
+>              Qext(nqmx-1)=qrefice
+>            endif
+>            qextrhor(nqmx-1)= (3./4.)*Qext(nqmx-1) 
+>      $       / (rho_ice*radius(nqmx-1))
+>          elseif(iceparty.and.nqmx.lt.2) then
+493c280
+<             write(*,*) 'water= ',water
+---
+>             write(*,*) 'water= ',water,' iceparty= ',iceparty
+1c1
+<        subroutine lwflux (kdlon,kflev,dp
+---
+>        subroutine lwflux (ig0,kdlon,kflev,dp
+28a29
+>       integer ig0                   ! 
+65c66
+<       integer ja,jl,j,i,ig1d,l,ndim
+---
+>       integer ja,jl,j,i,ig1d,ig,l,ndim
+94c95
+<       ksidb(jl,ja,i,j) = xi(jl,ja,i,j) 
+---
+>       ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j) 
+113c114
+<       ksidb(jl,ja,i,0) = xi(jl,ja,0,i) 
+---
+>       ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i) 
+132c133
+<      .                 - xi_ground(jl,ja) 
+---
+>      .                 - xi_ground(ig0+jl,ja) 
+150c151
+<       ksidb(jl,ja,i,nlaylte+1) = xi(jl,ja,i,nlaylte+1) 
+---
+>       ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) 
+167c168
+<       ksidb(jl,ja,0,nlaylte+1) = xi(jl,ja,0,nlaylte+1) 
+---
+>       ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) 
+262c263
+<      .               + xi(jl,ja,0,i) * (blay(jl,ja,i))
+---
+>      .               + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
+295c296
+< c     upward : flw_up(ig1d,l)   ;   downward : flw_dn(ig1d,j) 
+---
+> c     upward : flw_up(ig,l)   ;   downward : flw_dn(ig,j) 
+308c309
+<               coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(jl,ja,l,i)
+---
+>               coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+336c337
+<               coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(jl,ja,l,i)
+---
+>               coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+359a361,362
+> c ig0+1:  point du decoupage de la grille physique
+> c ig:   point pour les variables decoupees
+367c370,374
+<       print*, 'Sortie g2d: ig1d =', ig1d
+---
+>       if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
+>      .    .OR.  ngridmx.EQ.1   ) then
+> 
+>           ig = ig1d-ig0
+>         print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
+406c413
+<             reel4 = ksidb(ig1d,ja,i,j)
+---
+>             reel4 = ksidb(ig,ja,i,j)
+415c422
+<           reel4 = ksidb(ig1d,3,i,j)
+---
+>           reel4 = ksidb(ig,3,i,j)
+426c433
+<             dpsgcp(i,j) = dp(ig1d,j) / gcp
+---
+>             dpsgcp(i,j) = dp(ig,j) / gcp
+440c447
+< c     print*,i,'dp: ',dp(ig1d,i)
+---
+> c     print*,i,'dp: ',dp(ig,i)
+461c468
+<             temp(i,j) = tlay(ig1d,j)
+---
+>             temp(i,j) = tlay(ig,j)
+466c473
+<           temp(i,0) = tlev(ig1d,1)+dt0(ig1d)     ! temperature surface
+---
+>           temp(i,0) = tlev(ig,1)+dt0(ig)     ! temperature surface
+478c485
+<         write(76,*) 'ig1d =', ig1d
+---
+>         write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
+485,486c492,493
+<         write(76,*) 'bsurf', ja, bsurf(ig1d,ja)
+<         write(76,*) 'btop', ja, btop(ig1d,ja)
+---
+>         write(76,*) 'bsurf', ja, bsurf(ig,ja)
+>         write(76,*) 'btop', ja, btop(ig,ja)
+489c496
+<           write(76,*) 'blev', ja, j, blev(ig1d,ja,j)
+---
+>           write(76,*) 'blev', ja, j, blev(ig,ja,j)
+493c500
+<           write(76,*) 'blay', ja, j, blay(ig1d,ja,j)
+---
+>           write(76,*) 'blay', ja, j, blay(ig,ja,j)
+497c504
+<           write(76,*) 'dbsublay', ja, j, dbsublay(ig1d,ja,j)
+---
+>           write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
+500a508
+>       endif
+1c1
+<       subroutine lwi (kdlon,kflev
+---
+>       subroutine lwi (ig0,kdlon,kflev
+37c37
+<       integer kdlon,kflev
+---
+>       integer ig0, kdlon,kflev
+93,95c93,95
+<      .    ( xi(jl,1,i,nlaylte+1) 
+<      .    + xi(jl,1,i,i+1) 
+<      .    + xi(jl,1,i,i-1) )
+---
+>      .    ( xi(ig0+jl,1,i,nlaylte+1) 
+>      .    + xi(ig0+jl,1,i,i+1) 
+>      .    + xi(ig0+jl,1,i,i-1) )
+97,99c97,99
+<      .  + ( xi(jl,2,i,nlaylte+1) 
+<      .    + xi(jl,2,i,i+1) 
+<      .    + xi(jl,2,i,i-1) )
+---
+>      .  + ( xi(ig0+jl,2,i,nlaylte+1) 
+>      .    + xi(ig0+jl,2,i,i+1) 
+>      .    + xi(ig0+jl,2,i,i-1) )
+115,116c115,116
+<      .    ( xi(jl,1,nlaylte,nlaylte+1) 
+<      .    + xi(jl,1,nlaylte,nlaylte-1) )
+---
+>      .    ( xi(ig0+jl,1,nlaylte,nlaylte+1) 
+>      .    + xi(ig0+jl,1,nlaylte,nlaylte-1) )
+118,119c118,119
+<      .  + ( xi(jl,2,nlaylte,nlaylte+1) 
+<      .    + xi(jl,2,nlaylte,nlaylte-1) )
+---
+>      .  + ( xi(ig0+jl,2,nlaylte,nlaylte+1) 
+>      .    + xi(ig0+jl,2,nlaylte,nlaylte-1) )
+135,136c135,136
+<      .            (    xi(jl,1,i,i+1) * zdblay(jl,1,i+1)
+<      .               + xi(jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+---
+>      .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)
+>      .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+151,152c151,152
+<      .           (     xi(jl,1,i,i-1) * zdblay(jl,1,i-1)
+<      .               + xi(jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+---
+>      .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)
+>      .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+1c1
+<        subroutine lwmain (icount,kdlon,kflev
+---
+>        subroutine lwmain (ig0,icount,kdlon,kflev
+5,6c5
+<      .                   ,netrad
+<      &                   ,QIRsQREF3d,omegaIR3d,gIR3d)
+---
+>      .                   ,netrad)
+27a27
+>       integer ig0
+49,53c49
+<       real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
+< c     Aerosol optical properties
+<       REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+<       REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+<       REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+---
+>       real netrad (ndlo2,kflev)       ! radiative budget (W/m2) 
+116,117c112
+<      .         , dp, plev, tlay, aerosol
+<      &         , QIRsQREF3d,omegaIR3d,gIR3d
+---
+>      .         , dp, plev, tlay, aerosol  
+119c114
+<      .         , tautotal,omegtotal,gtotal)
+---
+>      .         ,tautotal,omegtotal,gtotal)   
+130c125
+<       call lwxd ( kdlon, kflev, emis
+---
+>       call lwxd ( ig0, kdlon, kflev, emis
+139c134
+<       call lwxn ( kdlon, kflev
+---
+>       call lwxn ( ig0, kdlon, kflev
+149c144
+<       call lwxb ( kdlon, kflev, emis
+---
+>       call lwxb ( ig0, kdlon, kflev, emis
+158c153
+<       call lwflux ( kdlon, kflev, dp
+---
+>       call lwflux ( ig0, kdlon, kflev, dp
+189c184
+<       call lwi (kdlon,kflev,netrad,dblay,dp
+---
+>       call lwi (ig0,kdlon,kflev,netrad,dblay,dp
+3d2
+<      &                ,QIRsQREF3d,omegaIR3d,gIR3d
+22,26d20
+< c
+< c Modif J.-B. Madeleine: Computing optical properties of dust and
+< c   water-ice crystals in each gridbox. Optical parameters of
+< c   water-ice clouds are convolved to crystal sizes predicted by
+< c   the microphysical scheme.
+38a33
+> #include "fisice.h"
+40a36,37
+> #include "aerice.h"
+>  
+56,58c53
+<       REAL QIRsQREF3d(ndlo2,kflev,nir,naerkind)  ! 3d ext. coef.
+<       REAL omegaIR3d(ndlo2,kflev,nir,naerkind)   ! 3d ssa
+<       REAL gIR3d(ndlo2,kflev,nir,naerkind)       ! 3d assym. param.
+---
+> 
+114a110,148
+> c TEST : to account for the varying sol/ir optical depth of ice with varying crystal size     
+> c      : and for varying w,g with varying crystal size     
+>               if (activice.and.n.eq.naerkind) then 
+>         ray=min( max(rice(jl,jk)*1.e+6, 1.),10.) 
+>             if (ja.eq.1.or.ja.eq.2) then 
+>           coefsize=(-0.00382*ray**3.+0.0503*ray**2.+0.03531)
+>      &             /QIRsQREF(ja,n)
+>           coefsizew=(-0.011*ray**2.+0.1824*ray-0.1283)
+>      &           /omegaIR(ja,n)
+>           coefsizeg=(-0.00122*ray**3.+0.009161*ray**2.+  
+>      &          0.1182*ray-0.096877)/gIR(ja,n)
+>                 elseif (ja.eq.3) then
+>           coefsize=(-0.00324*ray**3.+0.0419*ray**2.+0.0459)
+>      &             /QIRsQREF(ja,n)
+>           coefsizew=(-0.01292*ray**2.+0.1963*ray-0.06566)
+>      &           /omegaIR(ja,n)
+>           coefsizeg=(0.00271*ray**3.-0.05959*ray**2.+
+>      &          0.4411*ray-0.2724)/gIR(ja,n)
+>                 elseif (ja.eq.4) then
+>           coefsize=(-0.0003823*ray**3.+0.0104*ray**2.+0.005966)
+>      &             /QIRsQREF(ja,n)
+>               coefsizew=(-0.002*ray**3.+0.02623*ray**2.-0.014465)
+>      &           /omegaIR(ja,n)
+>           coefsizeg=(-0.0017192*ray**3.+0.0259*ray**2.-
+>      &          0.027692*ray+0.016099)/gIR(ja,n)
+>             endif
+>         if (coefsize.le.0.or.coefsizew.le.0.or.coefsizeg.le.0) 
+>      &        stop'pb dans lwu avec prp opt glace'
+> 
+>             tautotal(jl,jk,ja)=tautotal(jl,jk,ja) +
+>      &          QIRsQREF(ja,n)*aerosol(jl,jk,n)
+>      &          *coefsize
+>                 omegtotal(jl,jk,ja) =  omegtotal(jl,jk,ja) + 
+>      &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)
+>      &          *coefsize*coefsizew
+>                 gtotal(jl,jk,ja) =  gtotal(jl,jk,ja) + 
+>      &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)*gIR(ja,n)
+>      &          *coefsize*coefsizew*coefsizeg     
+>               else
+116c150
+<      &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)
+---
+>      &           QIRsQREF(ja,n)*aerosol(jl,jk,n)
+118,119c152
+<      &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+<      &           omegaIR3d(jl,jk,ja,n)
+---
+>      &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)
+121,122c154,155
+<      &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+<      &           omegaIR3d(jl,jk,ja,n)*gIR3d(jl,jk,ja,n)
+---
+>      &           QIRsQREF(ja,n)*aerosol(jl,jk,n)*omegaIR(ja,n)*gIR(ja,n)
+>               endif
+193d225
+< 
+1c1
+<       subroutine lwxb (kdlon,kflev
+---
+>       subroutine lwxb (ig0,kdlon,kflev
+61c61
+<       integer ja,jl,jk
+---
+>       integer ja,jl,jk,ig0
+173c173
+<       xi(jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+---
+>       xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+178c178
+<       xi(jl,ja,nlaylte+1,jk)      = xi(jl,ja,jk,nlaylte+1)
+---
+>       xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
+188c188
+<       xi(jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+---
+>       xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+192c192
+<       xi(jl,ja,jk,0) = xi(jl,ja,0,jk)
+---
+>       xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
+209c209
+<       xi(jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+---
+>       xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+213c213
+<       xi(jl,ja,nlaylte+1,0) = xi(jl,ja,0,nlaylte+1)
+---
+>       xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
+1c1
+<       subroutine lwxd (kdlon,kflev,emis
+---
+>       subroutine lwxd (ig0,kdlon,kflev,emis
+47a48
+>       integer ig0
+221c222
+<       xi(jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+---
+>       xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+228c229
+<       xi(jl,ja,jkk,jk)   = xi(jl,ja,jk,jkk)
+---
+>       xi(ig0+jl,ja,jkk,jk)   = xi(ig0+jl,ja,jk,jkk)
+247c248
+<       xi_emis(jl,ja,jk) =
+---
+>       xi_emis(ig0+jl,ja,jk) =
+1c1
+<       subroutine lwxn ( kdlon,kflev
+---
+>       subroutine lwxn ( ig0,kdlon,kflev
+85a86
+>       integer ig0
+345,346c346,347
+<             xi(jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+<      .                            + xi_emis(jl,ja,jk)
+---
+>             xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+>      .                            + xi_emis(ig0+jl,ja,jk)
+350c351
+<             xi(jl,ja,jk+1,jk) = xi(jl,ja,jk,jk+1)
+---
+>             xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
+363c364
+<             xi_ground(jl,ja)=0.
+---
+>             xi_ground(ig0+jl,ja)=0.
+371c372
+<       xi_ground(jl,ja) = xi_ground(jl,ja)
+---
+>       xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
+16,62c16
+< 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 
+---
+> 
+63a18,57
+> 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   Initialisation for the physical parametrisations of the LMD 
+> c   martian atmospheric general circulation modele.
+> c
+> c   author: Frederic Hourdin 15 / 10 /93
+> c   -------
+> c   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+> c   adapted to the WRF use - Aymeric Spiga - Jan 2007
+> c
+> c   arguments:
+> c   ----------
+> c
+> c   input:
+> c   ------
+> c
+> c    ngrid                 Size of the horizontal grid.
+> c                          All internal loops are performed on that grid.
+> c    nlayer                Number of vertical layers.
+> c    pdayref               Day of reference for the simulation
+> 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
+> c=======================================================================
+> c
+> c-----------------------------------------------------------------------
+> c   declarations:
+> c   -------------
+>  
+73,74d66
+< #include "dimradmars.h"  !!new
+< #include "yomaer.h"      !!new -- prob. pour remplir les proprietes
+75a68,69
+> 
+> 
+79c73
+<       REAL womeg,wmugaz,wdaysec
+---
+>       REAL womeg,wmugaz,wdaysec  
+84,85c78,79
+<       REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS
+<       REAL walbedodat(ngrid),winertiedat(ngrid),wphisfi(ngrid)
+---
+>       REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS     
+>       REAL walbedodat(ngrid),winertiedat(ngrid),wphisfi(ngrid) 
+90,92d83
+< !      REAL prad,pg,pr,pcpp,pdaysec,ptimestep
+< ! 
+< !      INTEGER ngrid,nlayer
+195d185
+<      
+197,207c187,195
+< !      rad=prad
+< !      daysec=pdaysec
+< !      dtphys=ptimestep
+< !      cpp=pcpp
+< !      g=pg
+< !      r=pr
+< !      rcp=r/cpp
+< 
+< ! --------------------------------------------------------
+< !     The usual Tests
+< !     --------------
+---
+>  
+> 
+> c --------------------------------------------------------
+> c     The usual Tests
+> c     --------------
+> 
+> c ****WRF
+> c useless here, because it was already done in the WRF driver
+> 
+224,228c212,228
+< ! --------------------------------------------------------------
+< !  Reading the "callphys.def" file controlling some key options
+< ! --------------------------------------------------------------
+<      
+<       ! check that 'callphys.def' file is around
+---
+> 
+> c --------------------------------------------------------------
+> c  Reading the "callphys.def" file controlling some key options
+> c --------------------------------------------------------------
+> 
+>       callrad=.true.
+>       calldifv=.true.
+>       calladj=.true.
+>       callcond=.true.
+>       callsoil=.true.
+>       season=.true.
+>       diurnal=.false.
+>       lwrite=.false.
+>       calllott=.true.
+>       iaervar=2
+>       iddist=3
+>       topdustref=55.
+230,232c230
+<      &     ,iostat=ierr)
+<       CLOSE(99)
+<       
+---
+>      .     ,iostat=ierr)
+237c235
+<          PRINT*,' inifis: Parametres pour la physique (callphys.def)'
+---
+>          PRINT*,' Parametres pour la physique (callphys.def)'
+239a238,239
+>          READ(99,*)
+>          READ(99,*)
+241,327c241,243
+<          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
+<          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
+<          
+---
+>          READ(99,fmt='(a)') ch1 
+>          READ(99,*) tracer
+>          WRITE(*,8000) ch1,tracer
+329,338c245,259
+<          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
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') diurnal
+>          WRITE(*,8000) ch1,diurnal
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') season
+>          WRITE(*,8000) ch1,season
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') lwrite
+>          WRITE(*,8000) ch1,lwrite
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callstats
+>          WRITE(*,8000) ch1,callstats
+340,344c261,266
+<          write(*,*)"call Lott's gravity wave/subgrid topography ",
+<      &             "scheme ?"
+<          calllott=.true. ! default value
+<          call getin("calllott",calllott)
+<          write(*,*)" calllott = ",calllott
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') calleofdump
+>          WRITE(*,8000) ch1,calleofdump
+> 
+>          READ(99,*)
+>          READ(99,*)
+345a268,276
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*,iostat=ierr) iaervar
+>          if(ierr.ne.0) stop'no iaervar in callphys.def (old?)'
+> c****WRF: ligne trop longue ....
+>          WRITE(*,8001) ch1,iaervar
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) iddist
+>          WRITE(*,8001) ch1,iddist
+347,351c278,291
+<          write(*,*)"rad.transfer is computed every iradia",
+<      &             " physical timestep"
+<          iradia=1 ! default value
+<          call getin("iradia",iradia)
+<          write(*,*)" iradia = ",iradia
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) topdustref
+>          WRITE(*,8002) ch1,topdustref
+> 
+>          READ(99,*)
+>          READ(99,*)
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callrad
+>          WRITE(*,8000) ch1,callrad
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callnlte
+>          WRITE(*,8000) ch1,callnlte
+352a293,307
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callnirco2
+>          WRITE(*,8000) ch1,callnirco2
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') calldifv
+>          WRITE(*,8000) ch1,calldifv
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') calladj
+>          WRITE(*,8000) ch1,calladj
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callcond
+>          WRITE(*,8000) ch1,callcond
+354,376c309,311
+<          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
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callsoil
+>          WRITE(*,8000) ch1,callsoil
+378,379c313,346
+< ! Test of incompatibility:
+< ! if active is used, then dustbin should be > 0
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') calllott
+>          WRITE(*,8000) ch1,calllott
+> 
+>          READ(99,*) 
+>          READ(99,*)
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) iradia
+>          WRITE(*,8001) ch1,iradia
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callg2d
+>          WRITE(*,8000) ch1,callg2d
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) rayleigh
+>          WRITE(*,8000) ch1,rayleigh
+> 
+>          READ(99,*) 
+>          READ(99,*)
+> 
+> c TRACERS:
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) dustbin
+>          WRITE(*,8001) ch1,dustbin
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) active
+>          WRITE(*,8000) ch1,active
+> 
+> c Test of incompatibility:
+> c if active is used, then dustbin should be > 0
+386,390c353,355
+<          write(*,*)"use mass and number mixing ratios to predict",
+<      &             " dust size ?"
+<          doubleq=.false. ! default value
+<          call getin("doubleq",doubleq)
+<          write(*,*)" doubleq = ",doubleq
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) doubleq
+>          WRITE(*,8000) ch1,doubleq
+392,393c357,358
+< ! Test of incompatibility:
+< ! if doubleq is used, then dustbin should be 1
+---
+> c Test of incompatibility:
+> c if doubleq is used, then dustbin should be 1
+400,403c365,367
+<          write(*,*)"dust lifted by GCM surface winds ?"
+<          lifting=.false. ! default value
+<          call getin("lifting",lifting)
+<          write(*,*)" lifting = ",lifting
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) lifting
+>          WRITE(*,8000) ch1,lifting
+405,406c369,370
+< ! Test of incompatibility:
+< ! if lifting is used, then dustbin should be > 0
+---
+> c Test of incompatibility:
+> c if lifting is used, then dustbin should be > 0
+413,417c377,379
+<          write(*,*)" dust lifted by dust devils ?"
+<          callddevil=.false. !default value
+<          call getin("callddevil",callddevil)
+<          write(*,*)" callddevil = ",callddevil
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) callddevil
+>          WRITE(*,8000) ch1,callddevil
+419,420c381,382
+< ! Test of incompatibility:
+< ! if dustdevil is used, then dustbin should be > 0
+---
+> c Test of incompatibility:
+> c if dustdevil is used, then dustbin should be > 0
+427,431c389,391
+<          write(*,*)"Dust scavenging by CO2 snowfall ?"
+<          scavenging=.false. ! default value
+<          call getin("scavenging",scavenging)
+<          write(*,*)" scavenging = ",scavenging
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) scavenging
+>          WRITE(*,8000) ch1,scavenging
+433,434c393,394
+< ! Test of incompatibility:
+< ! if scavenging is used, then dustbin should be > 0
+---
+> c Test of incompatibility:
+> c if scavenging is used, then dustbin should be > 0
+441,444c401,403
+<          write(*,*) "Gravitationnal sedimentation ?"
+<          sedimentation=.true. ! default value
+<          call getin("sedimentation",sedimentation)
+<          write(*,*) " sedimentation = ",sedimentation
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) sedimentation
+>          WRITE(*,8000) ch1,sedimentation
+446,450c405,407
+<          write(*,*) "Radiatively active transported atmospheric ",
+<      &              "water ice ?"
+<          activice=.false. ! default value
+<          call getin("activice",activice)
+<          write(*,*) " activice = ",activice
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) iceparty
+>          WRITE(*,8000) ch1,iceparty
+452,455c409,411
+<          write(*,*) "Compute water cycle ?"
+<          water=.false. ! default value
+<          call getin("water",water)
+<          write(*,*) " water = ",water
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) activice
+>          WRITE(*,8000) ch1,activice
+457c413,414
+< ! Test of incompatibility:
+---
+> c Test of incompatibility:
+> c if activice is used, then iceparty should be used too
+459,460c416,417
+<          if (activice.and..not.water) then
+<            print*,'if activice is used, water should be used too'
+---
+>          if (activice.and..not.iceparty) then
+>            print*,'if activice is used, iceparty should be used too'
+464,466c421,429
+<          if (water.and..not.tracer) then
+<            print*,'if water is used, tracer should be used too'
+<            stop
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) water
+>          WRITE(*,8000) ch1,water
+> 
+> c Test of incompatibility:
+> c if iceparty is used, then water should be used too
+> 
+>          if (.not.water) then
+>             iceparty = .false. 
+469c432,434
+< ! Test of incompatibility:
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) caps
+>          WRITE(*,8000) ch1,caps
+471,477c436,438
+<          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
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) photochem
+>          WRITE(*,8000) ch1,photochem
+479,482c440,441
+<          write(*,*) "photochemistry: include chemical species"
+<          photochem=.false. ! default value
+<          call getin("photochem",photochem)
+<          write(*,*) " photochem = ",photochem
+---
+>          READ(99,*)
+>          READ(99,*)
+483a443
+> c THERMOSPHERE
+485c445,447
+< ! THERMOSPHERE
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callthermos
+>          WRITE(*,8000) ch1,callthermos
+487,491c449,451
+<          write(*,*) "call thermosphere ?"
+<          callthermos=.false. ! default value
+<          call getin("callthermos",callthermos)
+<          write(*,*) " callthermos = ",callthermos
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') thermoswater
+>          WRITE(*,8000) ch1,thermoswater
+493,522c453,455
+<          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
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callconduct
+>          WRITE(*,8000) ch1,callconduct
+524,536c457,475
+<          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
+<          
+---
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') calleuv
+>          WRITE(*,8000) ch1,calleuv
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callmolvis
+>          WRITE(*,8000) ch1,callmolvis
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') callmoldiff
+>          WRITE(*,8000) ch1,callmoldiff
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,'(l1)') thermochem
+>          WRITE(*,8000) ch1,thermochem
+> 
+>          READ(99,fmt='(a)') ch1
+>          READ(99,*) solarcondate
+>          WRITE(*,*) ch1,solarcondate
+539,563c478,484
+<            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
+---
+>                  thermoswater=.false.          
+>                  callconduct=.false.          
+>                  calleuv=.false.          
+>                  callmolvis=.false.          
+>                  callmoldiff=.false.          
+>                  thermochem=.false.          
+>         end if
+565,566c486,487
+< ! Test of incompatibility:
+< ! if photochem is used, then water should be used too
+---
+> c Test of incompatibility:
+> c if photochem is used, then water should be used too
+573,574c494,495
+< ! if callthermos is used, then thermoswater should be used too 
+< ! (if water not used already)
+---
+> c if callthermos is used, then thermoswater should be used too 
+> c (if water not used already)
+591a513
+>       CLOSE(99)
+595c517
+< 
+---
+> 8002  FORMAT(t5,a12,f8.1)
+615c537
+<       PRINT*,'inifis: daysec',daysec
+---
+>       PRINT*,'daysec',daysec
+617c539
+<       PRINT*,'inifis: The radiative transfer is computed:'
+---
+>       PRINT*,'The radiative transfer is computed:'
+621,623d542
+< ! --------------------------------------------------------------
+< !  Managing the Longwave radiative transfer
+< ! --------------------------------------------------------------
+625,626c544,551
+< !     In most cases, the run just use the following values :
+< !     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> 
+> 
+> c --------------------------------------------------------------
+> c  Managing the Longwave radiative transfer
+> c --------------------------------------------------------------
+> 
+> c     In most cases, the run just use the following values :
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+628c553
+< !     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
+---
+> c     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
+637,638c562,563
+< !     BUT people working hard on the LW may want to read them in 'radia.def' 
+< !     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c     BUT people working hard on the LW may want to read them in 'radia.def' 
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+643c568
+<          write(*,*) 'inifis: Reading radia.def !!!'
+---
+>          write(*,*) 'Reading radia.def !!!'
+685d609
+<       CLOSE(99)
+687,689c611,613
+< !-----------------------------------------------------------------------
+< !     Some more initialization:
+< !     ------------------------
+---
+> c-----------------------------------------------------------------------
+> c     Some more initialization:
+> c     ------------------------
+691c615
+<       ! in 'comgeomfi.h' 
+---
+>       ! in 'comgeomfi.h'	
+705c629
+<       pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
+---
+>       pi=2.*asin(1.)
+707,708c631,632
+< !     managing the tracers, and tests:
+< !     -------------------------------
+---
+> c     managing the tracers, and tests:
+> c     -------------------------------
+712,713c636,637
+< !          when photochem is used, nqchem_min is the rank
+< !          of the first chemical species
+---
+> c          when photochem is used, nqchem_min is the rank
+> c          of the first chemical species
+715,716c639
+< ! Ehouarn: nqchem_min is now meaningless and no longer used
+< !       nqchem_min = 1
+---
+>        nqchem_min = 1
+718a642,646
+>         if (doubleq) then
+>           nqchem_min = 3
+>         else
+>           nqchem_min = dustbin+1
+>         end if
+723c651,653
+< !          TESTS
+---
+> c          TESTS
+> 
+>        print*,'TRACERS:'
+725c655,660
+<        print*,'inifis: TRACERS:'
+---
+>        if ((doubleq).and.(h2o).and.
+>      $     (chem).and.(iceparty)) then
+>          print*,' 1: dust ; 2: dust (doubleq)'
+>          print*,' 3 to ',nqmx-2,': chemistry'
+>          print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+>        endif
+728,732c663,666
+<      $     (chem)) then
+<          print*,' 2 dust tracers (doubleq)'
+<          print*,' 1 water vapour tracer'
+<          print*,' 1 water ice tracer'
+<          print*,nqmx-4,' chemistry tracers'
+---
+>      $     (chem).and..not.(iceparty)) then
+>          print*,' 1: dust ; 2: dust (doubleq)'
+>          print*,' 3 to ',nqmx-1,': chemistry'
+>          print*,nqmx,': water vapor'
+736,739c670,672
+<      $     .not.(chem)) then
+<          print*,' 2 dust tracers (doubleq)'
+<          print*,' 1 water vapour tracer'
+<          print*,' 1 water ice tracer'
+---
+>      $     .not.(chem).and.(iceparty)) then
+>          print*,' 1: dust ; 2: dust (doubleq)'
+>          print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+742c675,686
+< 		   print*,'(or check callphys.def)'
+---
+>            print*,'(or check callphys.def)'
+>            stop
+>          endif
+>        endif
+> 
+>        if ((doubleq).and.(h2o).and.
+>      $     .not.(chem).and..not.(iceparty)) then
+>          print*,' 1: dust ; 2: dust (doubleq)'
+>          print*,nqmx,': water vapor'
+>          if (nqmx.ne.3) then
+>            print*,'nqmx should be 3 with these options...'
+>            print*,'(or check callphys.def)'
+748c692
+<          print*,' 2 dust tracers (doubleq)'
+---
+>          print*,' 1: dust ; 2: dust (doubleq)'
+751c695
+< 		   print*,'(or check callphys.def)'
+---
+>            print*,'(or check callphys.def)'
+757c701
+<      $     (chem)) then
+---
+>      $     (chem).and.(iceparty)) then
+759c703
+<            print*,dustbin,' dust bins'
+---
+>            print*,' 1 to ',dustbin,': dust bins'
+761,763c705,714
+<          print*,nqmx-2-dustbin,' chemistry tracers'
+<          print*,' 1 water vapour tracer'
+<          print*,' 1 water ice tracer'
+---
+>          print*,nqchem_min,' to ',nqmx-2,': chemistry'
+>          print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+>        endif
+>        if (.not.(doubleq).and.(h2o).and.
+>      $     (chem).and..not.(iceparty)) then
+>          if (dustbin.gt.0) then
+>            print*,' 1 to ',dustbin,': dust bins'
+>          endif
+>          print*,nqchem_min,' to ',nqmx-1,': chemistry'
+>          print*,nqmx,': water vapor'
+765d715
+< 
+767c717
+<      $     .not.(chem)) then
+---
+>      $     .not.(chem).and.(iceparty)) then
+769c719
+<            print*,dustbin,' dust bins'
+---
+>            print*,' 1 to ',dustbin,': dust bins'
+771,773c721,722
+<          print*,' 1 water vapour tracer'
+<          print*,' 1 water ice tracer'
+<          if (nqmx.gt.(dustbin+2)) then
+---
+>          print*,nqmx-1,': water ice ; ',nqmx,': water vapor'
+>          if (nqmx.ne.(dustbin+2)) then
+776c725,732
+< 		   print*,'(or check callphys.def)'
+---
+>            print*,'(or check callphys.def)'
+>            stop
+>          endif
+>        endif
+>        if (.not.(doubleq).and.(h2o).and.
+>      $     .not.(chem).and..not.(iceparty)) then
+>          if (dustbin.gt.0) then
+>            print*,' 1 to ',dustbin,': dust bins'
+778c734,738
+<          if (nqmx.lt.(dustbin+2)) then
+---
+>          print*,nqmx,': water vapor'
+>          if (nqmx.ne.(dustbin+1)) then
+>            print*,'nqmx should be ',(dustbin+1),
+>      $            ' with these options...'
+>            print*,'(or check callphys.def)'
+782d741
+< 
+785c744
+<            print*,dustbin,' dust bins'
+---
+>            print*,' 1 to ',dustbin,': dust bins'
+799,800c758
+<       endif ! of if (tracer)
+< 
+---
+>       endif
+19c19
+< c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+---
+> c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+21c21
+< c       ... CHECK THE ****WRF lines
+---
+> c	... CHECK THE ****WRF lines
+39,44c39,42
+< 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      1. Initialisation:
+> c      1.5 Calculation of mean mass and cp, R and thermal conduction coeff.
+> c      2. Calcul of the radiative tendencies : radiative transfer
+> c         (longwave and shortwave) for CO2 and dust.
+47,56c45,53
+< 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      5. convective adjustment
+> c      6.  TRACERS :
+> c       6a. water and water ice
+> c       6b. call for photochemistry when tracers are chemical species
+> c       6c. other scheme for tracer (dust) transport (lifting, sedimentation)
+> c       6d. updates (CO2 pressure variations, surface budget)
+> c      7.  condensation and sublimation of carbon dioxide.
+> c      8. Surface and sub-surface temperature calculations
+> c      9. Writing output files :
+61c58
+< c     11. Diagnostic: mass conservation of tracers
+---
+> c      10. Diagnostic: mass conservation of tracers
+72,74c69
+< 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	    WRF version: Aymeric Spiga (01-03/2007)
+76a72
+> c
+105c101
+< c
+---
+> c 
+108,110c104,106
+< c       day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs
+< c               and locally saved variables
+< c                       (no need to call phyetat0)
+---
+> c	day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs 
+> c		and locally saved variables
+> c    			(no need to call phyetat0)
+133d128
+< #include "comsoil.h"     !!! new soil common 
+147c142
+< #include "fisice.h"     !!! new common
+---
+> #include "fisice.h"
+174,180c169,175
+<       INTEGER wday_ini
+<       REAL wtsurf(ngridmx)  ! input only ay firstcall - output
+<       REAL wtsoil(ngridmx,nsoilmx)
+<       REAL wco2ice(ngridmx)
+<       REAL wemis(ngridmx)
+<       REAL wqsurf(ngridmx,nqmx)
+<       REAL wq2(ngridmx,nlayermx+1)
+---
+>       INTEGER wday_ini  
+>       REAL wtsurf(ngridmx)  ! input only ay firstcall - output            
+>       REAL wtsoil(ngridmx,nsoilmx)    
+>       REAL wco2ice(ngridmx)             
+>       REAL wemis(ngridmx)             
+>       REAL wqsurf(ngridmx,nqmx)       
+>       REAL wq2(ngridmx,nlayermx+1) 
+195c190
+< 
+---
+>    
+202c197,211
+<       REAL pdpsrf(ngridmx) ! surface pressure tendency
+---
+>       REAL pdpsrf(ngridmx)
+> 
+> !!!!!!!TEST TEST
+> !      REAL spdu(ngridmx,nlayermx)
+> !      REAL spdv(ngridmx,nlayermx)
+> !      REAL spdt(ngridmx,nlayermx)
+> !      REAL spdq(ngridmx,nlayermx,nqmx)
+> !      REAL spdpsrf(ngridmx)
+> !      SAVE spdu
+> !      SAVE spdv
+> !      SAVE spdt
+> !      SAVE spdq
+> !      SAVE spdpsrf
+> !      LOGICAL nocalculphy
+> !!!!!!!TEST TEST      
+220,221c229
+<       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 fluxrad_save(ngridmx)     ! Net radiative surface flux (W.m-2)
+228,234d235
+< c     Variables used by the water ice microphysical scheme:
+<       REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+<       REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+<                                      !   of the size distribution
+<       REAL rnuclei(ngridmx,nlayermx)   ! Prescribed dust radius in each
+<                                      !   layer (m)
+< 
+238c239
+<       SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+---
+>       SAVE capcal,fluxgrd,dtrad,fluxrad_save, qsurf
+247a249
+>       REAL fluxrad(ngridmx)     ! Net radiative surface flux (W.m-2)
+250c252,253
+<       INTEGER l,ig,ierr,igout,iq,i, tapphys
+---
+>       INTEGER l,ig,ierr,igout,iq, tapphys
+>       INTEGER iqmin                     ! Used if iceparty engaged
+255a259,263
+> c     for clear area (uncovered by clouds) :
+>       REAL clsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2) 
+>       REAL clsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+>       REAL cltop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+>       REAL cltop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+259,261d266
+<       REAL, PARAMETER :: taufirstcall(ngridmx,naerkind) = 0.2
+<                                      ! Estimated column dust optical depth at
+<                                      ! firstcall
+267a273
+> 
+310a317
+>       REAL pclc_min ! minimum of the cloud fraction over the whole domain
+328c335
+<       real co2col(ngridmx)        ! CO2 column
+---
+> 
+330d336
+<       REAL zstress(ngrid), cd
+332,339c338,339
+<       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 opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+<       REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+<       REAL Qabsice                ! Ice absorption coefficient
+< 
+---
+>       real rho(ngridmx,nlayermx) ! density
+>       real vmr(ngridmx,nlayermx) ! volume mixing ratio
+342c342
+< 
+---
+>      
+344a345
+> 
+346a348
+>  
+348,350c350,352
+< c  1.1   Initialisation only at first call
+< c  ---------------------------------------
+<       IF (firstcall) THEN
+---
+> c     Initialisation only at first call
+> c     ---------------------------------
+>       IF(firstcall) THEN
+358,360c360
+< c        read startfi 
+< c        ~~~~~~~~~~~~
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+362,367c362,367
+< 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
+> 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
+383,385c383,385
+< 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	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:
+394c394
+<               !!PRINT*,ecri_phys
+---
+>               !!PRINT*,ecri_phys  
+396c396
+<               !!renvoient tous deux des nombres absurdes
+---
+>               !!renvoient tous deux des nombres absurdes 
+399c399
+<               !!donc ecritphys est passe en argument ...
+---
+>               !!donc ecritphys est passe en argument ... 
+403,406c403
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+< 
+< 
+< 
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+408,412d404
+< !! Read netcdf initial physical parameters.
+< !         CALL phyetat0 ("startfi.nc",0,0,
+< !     &         nsoilmx,nq,
+< !     &         day_ini,time_phys,
+< !     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+415,418c407,409
+<            write(*,*) "PHYSIQ: ERROR: bad synchronization between ",
+<      &                "physics and dynamics"
+<            write(*,*) "dynamics day: ",pday
+<            write(*,*) "physics day:  ",day_ini
+---
+>            write(*,*) "***ERROR Pb de synchronisation entre phys et dyn"
+>            write(*,*) "jour dynamique: ",pday
+>            write(*,*) "jour physique: ",day_ini
+422c413,415
+<          write (*,*) 'In physiq day_ini =', day_ini
+---
+>          write (*,*) 'In physic day_ini =', day_ini
+> 
+> 
+429,430c422,423
+< c        initialize soil 
+< c        ~~~~~~~~~~~~~~~
+---
+> c        initialisation soil 
+> c        ~~~~~~~~~~~~~~~~~~~
+444,445c437,438
+< c        initialize tracers
+< c        ~~~~~~~~~~~~~~~~~~
+---
+> c        initialisation pour les traceurs
+> c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+452c445
+< cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+458,459c451
+< cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< c
+---
+> cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+467a460
+> c
+469c462
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+471,472d463
+< c        Initialize thermospheric parameters
+< c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+473a465,466
+> c        Initializing thermospheric parameters
+> c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+476c469
+< c        Initialize R and Cp as constant
+---
+> c        Initializing R and Cp as constant
+490,492c483,499
+< c ---------------------------------------------------
+< c 1.2   Initializations done at every physical timestep:
+< c ---------------------------------------------------
+---
+> !!!!!!!!!!!!!!!!TEST TEST
+> !      IF (nocalculphy) THEN
+> !
+> !            write(*,*) 'tendencies are not recalculated !'  
+> !            pdu(:,:)=spdu(:,:) 
+> !            pdv(:,:)=spdv(:,:)
+> !            pdt(:,:)=spdt(:,:)
+> !            pdq(:,:,:)=spdq(:,:,:)
+> !            pdpsrf(:)=spdpsrf(:)
+> !            write(*,*) pdu(100,10), pdv(100,10), pdt(100,10)  
+> !      ELSE      
+> !!!!!!!!!!!!!!!!TEST TEST
+> 
+> 
+> c    ------------------------------------------
+> c    Initialisations at every physical timestep:
+> c    ------------------------------------------
+502,503c509,525
+< c     Initialize various variables
+< c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+>       zday=pday+ptime
+> 
+> 
+> 
+> c     Computing Solar Longitude (Ls) :
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+>       if (season) then 
+>          PRINT*,'day',zday
+>          CALL solarlong(zday,zls)
+>       else
+>          PRINT*,'day_ini',day_ini
+>          call solarlong(float(day_ini),zls) 
+>       end if
+> 
+> 
+> c     Initializing various variable
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+514,526c536,537
+< 
+<       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     computing geopotentiel at interlayer levels
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+531c542
+<             zzlay(ig,l)=pphi(ig,l)/g
+---
+>             zzlay(ig,l)=pphi(ig,l)/g    
+549,550c560,561
+< c     Compute potential temperature
+< c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c     Computing potential temperature
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+559,560c570,571
+< c    1.2.5 Compute mean mass, cp, and R
+< c    --------------------------------
+---
+> c    1.5 Calculation of mean mass, cp, and R
+> c    ---------------------------------------
+566,567c577,578
+< c    2. Compute radiative tendencies :
+< c------------------------------------
+---
+> c    2. Calcul of the radiative tendencies :
+> c    ---------------------------------------
+570c581
+<       IF (callrad) THEN
+---
+>       IF(callrad) THEN
+576a588
+>         
+597a610
+> 
+599,600c612,614
+<            IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+<      &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+---
+>            IF(MOD(iphysiq*(icount-1),day_step).EQ.0) THEN          
+>                 CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+>            ENDIF
+602,607d615
+< 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)
+609,610c617,618
+< c          Estimate the ice particle size distribution at firstcall:
+< c          --------------------------------------------------------
+---
+> c          Atmospheric dust opacity and aerosol distribution:
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+612,621d619
+< c
+< c **WRF: a verifier
+< c
+<            IF (firstcall.AND.activice) THEN
+<              CALL watercloud(ngrid,nlayer,ptimestep,
+<      &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+<      &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+<      &                nq,naerkind,taufirstcall,
+<      &                rnuclei,rice,nuice)
+<            ENDIF
+623,629c621,722
+< 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,
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+> cc*****WRF
+>          CALL meso_dustopacity(ngrid,nlayer,nq,
+>      $          zday,pplay,pplev,zls,pq,
+>      $      tauref,tau,aerosol)
+> 
+> cc*****WRF
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+> 
+>         
+> c          Calling main radiative transfer scheme
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c          Transfer through dust and CO2, except NIR CO2 absorption
+> 
+> c ----------
+> c partie rajoutee par Franck, commentee pour l'instant
+> c ----------
+> c
+> c           if (ngridmx.eq.1) pclc(1)=1. !TEST for 1D simulation
+> c
+> c           pclc_min=1.
+> c           if (activice.and.naerkind.gt.1) then
+> c             do ig=1,ngrid
+> c               pclc_min=min(pclc_min,pclc(ig))
+> c             enddo
+> c           endif
+> c
+> c           IF(activice.and.naerkind.gt.1.and.pclc_min.lt.1) THEN
+> c          Computing radiative tendencies accounting for a cloudy area (0< pclc(ngrid) <1)
+> c          pclc is set in initracer (prescribed for the moment).
+> c          two steps : 1/rad. tend. without clouds (aerosol(*,*,2)=0.)
+> c          ~~~~~~~~~   2/rad. tend. with clouds
+> c                      3/final tendencies=average of 1/ and 2/ weighted by the
+> cloud area (pclc)
+> c
+> c
+> c 1/
+> c           call zerophys(nlayer*ngrid,aerosol(1,1,2))  !remettre
+> c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+> c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+> c     $     cldtlw,cldtsw,clsurf_lw,clsurf_sw,cltop_lw,cltop_sw)
+> c
+> c 2/
+> c           CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+> c     $     tau,aerosol,zls,co2ice)
+> c
+> c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+> c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+> c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+> c
+> c 3/
+> c           do l=1,nlayer
+> c             do ig=1,ngrid
+> c             zdtlw(ig,l)=(1.-pclc(ig))*cldtlw(ig,l)+pclc(ig)*zdtlw(ig,l)
+> c             zdtsw(ig,l)=(1.-pclc(ig))*cldtsw(ig,l)+pclc(ig)*zdtsw(ig,l)
+> c             enddo
+> c           enddo
+> c           do ig=1,ngrid
+> c             fluxsurf_lw(ig)=(1.-pclc(ig))*clsurf_lw(ig)+
+> c     $        pclc(ig)*fluxsurf_lw(ig)
+> c             fluxtop_lw(ig)=(1.-pclc(ig))*cltop_lw(ig)+
+> c     $        pclc(ig)*fluxtop_lw(ig)
+> c
+> c             fluxsurf_sw(ig,1)=(1.-pclc(ig))*clsurf_sw(ig,1)+
+> c     $        pclc(ig)*fluxsurf_sw(ig,1)
+> c             fluxsurf_sw(ig,2)=(1.-pclc(ig))*clsurf_sw(ig,2)+
+> c     $        pclc(ig)*fluxsurf_sw(ig,2)
+> c
+> c             fluxtop_sw(ig,1)=(1.-pclc(ig))*cltop_sw(ig,1)+
+> c     $        pclc(ig)*fluxtop_sw(ig,1)
+> c             fluxtop_sw(ig,2)=(1.-pclc(ig))*cltop_sw(ig,2)+
+> c     $        pclc(ig)*fluxtop_sw(ig,2)
+> c           enddo
+> c
+> c           ELSE
+> c
+> c          Atmospheric water ice opacity and particle distribution:
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c
+> c           if (activice.and.naerkind.gt.1)
+> c     &      CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+> c     &      tau,aerosol,zls,co2ice)
+> c
+> c
+> c ----------
+> c  fin partie rajoutee par Franck (plus ENDIF ci-dessous)
+> c ----------
+> 
+> 
+> !          DO ig=1,ngrid
+> !            DO l=1,nlayer
+> !                   IF ( (pplev(ig,l+1) - pplev(ig,l) ) .gt. 0. )
+> !     .                PRINT*,'pb1 ',
+> !     .                        pplev(ig,l),
+> !     .                        pplev(ig,l+1),
+> !     .                        pplev(ig,l+1)-pplev(ig,l),
+> !     .                        l,
+> !     .                        ig
+> !            ENDDO
+> !         ENDDO
+> 
+>            CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+631,632c724,740
+<      $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+<      &     tauref,tau,aerosol,rice,nuice)
+---
+>      $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+> 
+> !           DO ig=1,ngrid
+> !            zdtlw(ig)=zdtlw(1)
+> !            zdtsw(ig)=zdtsw(1)
+> !            fluxsurf_lw(ig)=fluxsurf_lw(1)
+> !            fluxsurf_sw(ig,1)=fluxsurf_sw(1,1)
+> !            fluxsurf_sw(ig,2)=fluxsurf_sw(1,2)
+> !            fluxtop_lw(ig)=fluxtop_lw(1)
+> !            fluxtop_sw(ig,1)=fluxtop_sw(1,1) 
+> !            fluxtop_sw(ig,2)=fluxtop_sw(1,2)
+> !           ENDDO
+> 
+> c ----------
+> c           ENDIF ! end of condition on the cloudy fraction
+> c ----------
+> 
+697a806
+> 
+701c810
+<                fluxrad_sky(ig)=emis(ig)*fluxsurf_lw(ig)
+---
+>                fluxrad_save(ig)=emis(ig)*fluxsurf_lw(ig)
+726a836,839
+>            !PRINT*,'zdtsw',zdtsw
+>            !PRINT*,'zdtlw',zdtlw
+>            !PRINT*,'zdtnirco2',zdtnirco2
+>            !PRINT*,'dtrad',dtrad
+729,731c842
+<         ENDIF ! of if(mod(icount-1,iradia).eq.0)
+< 
+< 
+---
+>         ENDIF ! mod(icount-1,iradia).eq.0
+734c845
+< c    -------------------------------------------
+---
+> c    -----------------------------------------------
+738d848
+< c
+743c853
+<                fluxrad(ig)=fluxrad_sky(ig)-zplanck(ig)
+---
+>                fluxrad(ig)=fluxrad_save(ig)-zplanck(ig)
+761c871
+<       ENDIF ! of IF (callrad)
+---
+>       ENDIF
+788d897
+<       IF (calldifv) THEN
+789a899
+>       IF(calldifv) THEN
+878c988
+<          if (tracer) then 
+---
+>          if(tracer) then 
+891c1001
+<          end if ! of if (tracer)
+---
+>          end if
+905c1015
+<       ENDIF ! of IF (calldifv)
+---
+>       ENDIF
+950c1060
+<       ENDIF ! of IF(calladj)
+---
+>       ENDIF
+956c1066
+<       IF (callcond) THEN
+---
+>       IF(callcond) THEN
+973,976c1083
+< !!!**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
+---
+>             ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+979c1086
+<          IF (tracer) THEN
+---
+>          IF(tracer) THEN
+987c1094
+<          ENDIF ! of IF (tracer)
+---
+>          END IF !(tracer)
+989c1096
+<       ENDIF  ! of IF (callcond)
+---
+>       ENDIF  !(callcond) 
+990a1098
+> c        print*,'condens ok'
+995c1103
+<       if (tracer) then 
+---
+>       if(tracer) then 
+1005,1009c1113
+< 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,
+---
+>            call watercloud(ngrid,nlayer, ptimestep,
+1011,1014c1115,1118
+<      &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+<      &                nq,naerkind,tau,
+<      &                rnuclei,rice,nuice)
+< c          if (activice) then
+---
+>      &                pq,pdq,zdqcloud,qsurf,zdqscloud,zdtcloud,
+>      &                nq,naerkind,tau,icount,zls)
+> 
+>            if (activice) then
+1016,1021c1120,1131
+< c          DO l=1,nlayer
+< c            DO ig=1,ngrid
+< c              pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+< c            ENDDO
+< c          ENDDO
+< c          endif
+---
+>            DO l=1,nlayer
+>              DO ig=1,ngrid
+>                pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+>              ENDDO
+>            ENDDO
+>            endif
+> 
+>            IF (iceparty) then
+>              iqmin=nq-1
+>            ELSE
+>              iqmin=nq
+>            ENDIF
+1023,1024c1133
+< ! increment water vapour and ice atmospheric tracers tendencies
+<            IF (water) THEN
+---
+>            DO iq=iqmin,nq
+1026,1031c1135,1137
+<                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
+---
+>                 DO ig=1,ngrid
+>                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+>                 ENDDO
+1033,1040c1139,1144
+<            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)
+---
+>              DO ig=1,ngrid
+>                 dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+>              ENDDO
+>            ENDDO
+> 
+>          END IF  ! (water)
+1048c1152
+<          IF (photochem .or. thermochem) then
+---
+>          IF(photochem .or. thermochem) then
+1050,1056c1154,1159
+<      &      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
+---
+>      .      zzlay,zday,pq,pdq,zdqchim,zdqschim,zdqcloud,zdqscloud)
+>            
+> c Photochemistry includes condensation of H2O2
+> 
+>            do iq=nqchem_min,nq
+>             if (noms(iq).eq."h2o2") then
+1059c1162,1163
+<                  pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
+---
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+1062,1064c1166
+<            ENDDO ! of DO iq=1,nq
+<            ! add condensation tendency for H2O2
+<            if (igcm_h2o2.ne.0) then
+---
+>             else
+1067,1068c1169
+<                  pdq(ig,l,igcm_h2o2)=pdq(ig,l,igcm_h2o2)
+<      &                                +zdqcloud(ig,l,igcm_h2o2)
+---
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+1071,1086c1172,1185
+<            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
+---
+>             endif
+>            ENDDO
+>            do iq=nqchem_min,nq
+>             if (noms(iq).eq."h2o2") then
+>                DO ig=1,ngrid
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+>                ENDDO
+>             else
+>                DO ig=1,ngrid
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+>                ENDDO
+>             endif
+>            ENDDO
+1088c1187,1188
+<          END IF  ! of IF (photochem.or.thermochem)
+---
+>          END IF  ! (photochem.or.thermochem)
+> c        print*,'photochem ok'
+1113c1213
+<            endif  ! of if (dustbin.ge.1)
+---
+>            endif  ! (test sur dustbin)
+1115c1215
+<          END IF ! of IF (callddevil)
+---
+>          END IF
+1129,1131d1228
+< c
+< c **WRF: new arguments rnuclei, rice, need checks
+< c
+1133c1230
+<      &                pplev,zzlev, pt, rnuclei, rice,
+---
+>      &                pplev,zzlev, pt,
+1136a1234
+> 
+1149c1247,1249
+<          END IF   ! of IF (sedimentation)
+---
+>          END IF   ! (sedimentation)
+> 
+> c        print*,'sedim ok'
+1165c1265,1267
+<       endif !  of if (tracer) 
+---
+>       END IF    ! (tracer) 
+> 
+> c        print*,'tracers ok'
+1169c1271
+< c   8. THERMOSPHERE CALCULATION
+---
+> c   8.5 THERMOSPHERE CALCULATION
+1176a1279,1281
+> c           do iq=nqchem_min,nq
+> c           write(*,*) 'thermo iq,pq',iq,pq(690,1,iq)
+> c           enddo
+1191d1295
+<       endif ! of if (callthermos)
+1192a1297
+>       endif
+1194c1299
+< c   9. Surface  and sub-surface soil temperature
+---
+> c   8. Surface  and sub-surface soil temperature
+1198,1199c1303,1304
+< c   9.1 Increment Surface temperature:
+< c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c   Surface temperature incrementation :
+> c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1205,1210d1309
+< 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
+1212c1311,1314
+<       IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+---
+> c  Prescription piege froid au pole sud (Except at high obliquity !!)
+> c  temperature en surface = temperature equilibre de phases du CO2
+>        
+>       IF (tracer.AND.water.AND.ngridmx.NE.1) THEN
+1214,1217c1316
+<            ! 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)))
+---
+>            tsurf(ngrid)=1/(1/136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
+1225,1227d1323
+< c
+< c **WRF : OK avec le mesoscale, pas d'indices bizarres au pole
+< c
+1229,1231c1325,1328
+<            if ((co2ice(ig).eq.0).and.
+<      &        (qsurf(ig,igcm_h2o_ice).gt.0.005)) then
+<               albedo(ig,1)=0.45                                     
+---
+> 
+> c       -------------- Version temporaire fit TES 2008 ------------
+>          if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+>               albedo(ig,1)=0.45
+1233c1330,1344
+<            endif
+---
+>           endif
+> 
+> c         if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+> c           if (.not.watercaptag(ig)) then
+> c             albedo(ig,1)=0.4
+> c             albedo(ig,2)=0.4
+> c           endif
+> c         endif
+> c       -------------- version Francois ---------------
+> c          if (co2ice(ig).eq.0.and.
+> c    &        ((qsurf(ig,nqmx).gt.0.005).or.(watercaptag(ig)))) then
+> c              albedo(ig,1)=max(0.4,albedodat(ig))
+> c              albedo(ig,2)=albedo(ig,1)
+> c          endif
+> c       ---------------------------------------------
+1235c1346,1349
+<       ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+---
+>       ENDIF  ! of IF (tracer.AND.water.AND.ngridmx.NE.1)
+> 
+> 
+> c        print*,'tracer, water and 3D ok'
+1238,1239c1352,1353
+< c   9.2 Compute soil temperatures and subsurface heat flux:
+< c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c   soil temperatures and subsurface heat flux:
+> c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1242c1356
+<      &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+---
+>      s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+1244a1359,1364
+> c        print*,'soil ok'
+> 
+> 
+> 
+> 
+> 
+1246,1247c1366,1367
+< c  10. Write output files
+< c  ----------------------
+---
+> c  9. Writing output files
+> c  ------------------------
+1253c1373
+<       ! temperature, zonal and meridional wind
+---
+> 
+1261,1262d1380
+< 
+<       ! tracers
+1270,1271d1387
+< 
+<       ! surface pressure
+1273c1389
+<           ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+---
+>           ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep !already in 7
+1275,1276d1390
+< 
+<       ! pressure
+1283,1284c1397
+< 
+<       ! Density 
+---
+>       ! Density calculation
+1291,1296d1403
+< 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
+< 
+1299,1300c1406,1407
+< 	     fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+< 	     fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+---
+>             fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+>             fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+1302c1409
+< c ******* TEST ******************************************************
+---
+> c ******* TEMPORAIRE ************************************************
+1313,1314c1420,1421
+<       if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then	
+<         write(*,*) 'PHYSIQ: stability WARNING :'
+---
+>       if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then
+>         write(*,*) 'stability WARNING :' 
+1320,1322c1427,1430
+< c     ---------------------
+< c     Outputs to the screen 
+< c     ---------------------
+---
+> c     --------------------
+> c     Output on the screen 
+> c     --------------------
+> 
+1337c1445
+<       ENDIF ! of IF (lwrite)
+---
+>       ENDIF
+1338a1447,1457
+> cc****WRF
+> cc      IF (ngrid.NE.1) THEN
+> c	PRINT*,'check - values after update at ngrid/2+1'
+> c         WRITE(*,'(a4,a6,2a10)') 'l','u','v','T'
+> c         WRITE(*,'(i4,3f10.5)') (l,
+> c     s   zu(igout,l),
+> c     s   zv(igout,l),
+> c     s   zt(igout,l),
+> c     s   l=1,nlayer)
+> c
+> cc****WRF
+1340d1458
+<       IF (ngrid.NE.1) THEN
+1342,1343c1460,1462
+<      &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)!,
+< !     &   ' tau(Viking1) =',tau(ig_vl1,1)
+---
+>      &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)
+> c     &   ' tau(Viking1) =',tau(ig_vl1,1)
+> 
+1348,1352c1467,1472
+< 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
+---
+> c        Remarque : On  stocke restarfi 
+> c        juste avant que la dynamique ne le soit dans restart.
+> c        entre maintenant et l'ecriture de restart,
+> c        on aura itau = itau +1 et remise a jour de time.
+> c        (lastcall = .true. lorsque itau+1 = itaufin)
+> c        Donc on stocke  avec time = time + dtvr
+1356c1476
+<             write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+---
+>             write(*,*)'pour physdem ztime_fin =',ztime_fin
+1364,1501d1483
+< 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,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
+< 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)-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))
+<                  tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+<                enddo
+<              enddo
+< 
+<            endif ! of if (water)
+<          endif ! of if (tracer)
+< 
+< c        -----------------------------------------------------------------
+< c        WSTATS: Saving statistics
+< c        -----------------------------------------------------------------
+< c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+< c        which can later be used to make the statistic files of the run:
+< c        "stats")          only possible in 3D runs !
+< 
+<          
+<          IF (callstats) THEN
+< 
+<            call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
+<            call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+<            call wstats(ngrid,"co2ice","CO2 ice cover",
+<      &                "kg.m-2",2,co2ice)
+<            call wstats(ngrid,"fluxsurf_lw",
+<      &                "Thermal IR radiative flux to surface","W.m-2",2,
+<      &                fluxsurf_lw)
+<            call wstats(ngrid,"fluxsurf_sw",
+<      &                "Solar radiative flux to surface","W.m-2",2,
+<      &                fluxsurf_sw_tot)
+<            call wstats(ngrid,"fluxtop_lw",
+<      &                "Thermal IR radiative flux to space","W.m-2",2,
+<      &                fluxtop_lw)
+<            call wstats(ngrid,"fluxtop_sw",
+<      &                "Solar radiative flux to space","W.m-2",2,
+<      &                fluxtop_sw_tot)
+<            call wstats(ngrid,"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
+1550,1748c1532
+< !!
+< !! ***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,' local tau =',tau(1,1)
+< 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')
+<          CALL writeg1d(ngrid,1,ps,'ps','Pa')
+<          
+<          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')
+< 
+<          if(tracer) then
+< c           CALL writeg1d(ngrid,1,tau,'tau','SI')
+<             do iq=1,nq
+<               CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+<             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
+---
+>       icount=icount+1
+1750c1534,1536
+<       END IF       ! if(ngrid.ne.1)
+---
+> !!!!!!!!!!!!!TEST TEST
+> !        ENDIF
+> !!!!!!!!!!!!!TEST TEST      
+1752d1537
+<       icount=icount+1
+19c19
+< c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+---
+> c	CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+21c21
+< c       ... CHECK THE ****WRF lines
+---
+> c	... CHECK THE ****WRF lines
+39,44c39,42
+< 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      1. Initialisation:
+> c      1.5 Calculation of mean mass and cp, R and thermal conduction coeff.
+> c      2. Calcul of the radiative tendencies : radiative transfer
+> c         (longwave and shortwave) for CO2 and dust.
+47,56c45,53
+< 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      5. convective adjustment
+> c      6.  TRACERS :
+> c       6a. water and water ice
+> c       6b. call for photochemistry when tracers are chemical species
+> c       6c. other scheme for tracer (dust) transport (lifting, sedimentation)
+> c       6d. updates (CO2 pressure variations, surface budget)
+> c      7.  condensation and sublimation of carbon dioxide.
+> c      8. Surface and sub-surface temperature calculations
+> c      9. Writing output files :
+61c58
+< c     11. Diagnostic: mass conservation of tracers
+---
+> c      10. Diagnostic: mass conservation of tracers
+72,74c69
+< 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	    WRF version: Aymeric Spiga (01-03/2007)
+76a72
+> c
+105c101
+< c
+---
+> c 
+108,110c104,106
+< c       day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs
+< c               and locally saved variables
+< c                       (no need to call phyetat0)
+---
+> c	day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs 
+> c		and locally saved variables
+> c    			(no need to call phyetat0)
+133d128
+< #include "comsoil.h"     !!! new soil common 
+147c142
+< #include "fisice.h"     !!! new common
+---
+> #include "fisice.h"
+174,180c169,175
+<       INTEGER wday_ini
+<       REAL wtsurf(ngridmx)  ! input only ay firstcall - output
+<       REAL wtsoil(ngridmx,nsoilmx)
+<       REAL wco2ice(ngridmx)
+<       REAL wemis(ngridmx)
+<       REAL wqsurf(ngridmx,nqmx)
+<       REAL wq2(ngridmx,nlayermx+1)
+---
+>       INTEGER wday_ini  
+>       REAL wtsurf(ngridmx)  ! input only ay firstcall - output            
+>       REAL wtsoil(ngridmx,nsoilmx)    
+>       REAL wco2ice(ngridmx)             
+>       REAL wemis(ngridmx)             
+>       REAL wqsurf(ngridmx,nqmx)       
+>       REAL wq2(ngridmx,nlayermx+1) 
+195c190
+< 
+---
+>    
+202c197,211
+<       REAL pdpsrf(ngridmx) ! surface pressure tendency
+---
+>       REAL pdpsrf(ngridmx)
+> 
+> !!!!!!!TEST TEST
+> !      REAL spdu(ngridmx,nlayermx)
+> !      REAL spdv(ngridmx,nlayermx)
+> !      REAL spdt(ngridmx,nlayermx)
+> !      REAL spdq(ngridmx,nlayermx,nqmx)
+> !      REAL spdpsrf(ngridmx)
+> !      SAVE spdu
+> !      SAVE spdv
+> !      SAVE spdt
+> !      SAVE spdq
+> !      SAVE spdpsrf
+> !      LOGICAL nocalculphy
+> !!!!!!!TEST TEST      
+220,221c229
+<       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 fluxrad_save(ngridmx)     ! Net radiative surface flux (W.m-2)
+228,234d235
+< c     Variables used by the water ice microphysical scheme:
+<       REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+<       REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+<                                      !   of the size distribution
+<       REAL rnuclei(ngridmx,nlayermx)   ! Prescribed dust radius in each
+<                                      !   layer (m)
+< 
+238c239
+<       SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+---
+>       SAVE capcal,fluxgrd,dtrad,fluxrad_save, qsurf
+247a249
+>       REAL fluxrad(ngridmx)     ! Net radiative surface flux (W.m-2)
+250c252,253
+<       INTEGER l,ig,ierr,igout,iq,i, tapphys
+---
+>       INTEGER l,ig,ierr,igout,iq, tapphys
+>       INTEGER iqmin                     ! Used if iceparty engaged
+255a259,263
+> c     for clear area (uncovered by clouds) :
+>       REAL clsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2) 
+>       REAL clsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+>       REAL cltop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+>       REAL cltop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+259,261d266
+<       REAL, PARAMETER :: taufirstcall(ngridmx,naerkind) = 0.2
+<                                      ! Estimated column dust optical depth at
+<                                      ! firstcall
+267a273
+> 
+310a317
+>       REAL pclc_min ! minimum of the cloud fraction over the whole domain
+328c335
+<       real co2col(ngridmx)        ! CO2 column
+---
+> 
+330d336
+<       REAL zstress(ngrid), cd
+332,339c338,339
+<       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 opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+<       REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+<       REAL Qabsice                ! Ice absorption coefficient
+< 
+---
+>       real rho(ngridmx,nlayermx) ! density
+>       real vmr(ngridmx,nlayermx) ! volume mixing ratio
+342c342
+< 
+---
+>      
+344a345
+> 
+346a348
+>  
+348,350c350,352
+< c  1.1   Initialisation only at first call
+< c  ---------------------------------------
+<       IF (firstcall) THEN
+---
+> c     Initialisation only at first call
+> c     ---------------------------------
+>       IF(firstcall) THEN
+358,360c360
+< c        read startfi 
+< c        ~~~~~~~~~~~~
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+362,367c362,367
+< 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
+> 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
+383,385c383,385
+< 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	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:
+394c394
+<               !!PRINT*,ecri_phys
+---
+>               !!PRINT*,ecri_phys  
+396c396
+<               !!renvoient tous deux des nombres absurdes
+---
+>               !!renvoient tous deux des nombres absurdes 
+399c399
+<               !!donc ecritphys est passe en argument ...
+---
+>               !!donc ecritphys est passe en argument ... 
+403,406c403
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+< 
+< 
+< 
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+408,412d404
+< !! Read netcdf initial physical parameters.
+< !         CALL phyetat0 ("startfi.nc",0,0,
+< !     &         nsoilmx,nq,
+< !     &         day_ini,time_phys,
+< !     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+415,418c407,409
+<            write(*,*) "PHYSIQ: ERROR: bad synchronization between ",
+<      &                "physics and dynamics"
+<            write(*,*) "dynamics day: ",pday
+<            write(*,*) "physics day:  ",day_ini
+---
+>            write(*,*) "***ERROR Pb de synchronisation entre phys et dyn"
+>            write(*,*) "jour dynamique: ",pday
+>            write(*,*) "jour physique: ",day_ini
+422c413,415
+<          write (*,*) 'In physiq day_ini =', day_ini
+---
+>          write (*,*) 'In physic day_ini =', day_ini
+> 
+> 
+429,430c422,423
+< c        initialize soil 
+< c        ~~~~~~~~~~~~~~~
+---
+> c        initialisation soil 
+> c        ~~~~~~~~~~~~~~~~~~~
+444,445c437,438
+< c        initialize tracers
+< c        ~~~~~~~~~~~~~~~~~~
+---
+> c        initialisation pour les traceurs
+> c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+452c445
+< cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+458,459c451
+< cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< c
+---
+> cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+467a460
+> c
+469c462
+< ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+471,472d463
+< c        Initialize thermospheric parameters
+< c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+473a465,466
+> c        Initializing thermospheric parameters
+> c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+476c469
+< c        Initialize R and Cp as constant
+---
+> c        Initializing R and Cp as constant
+490,492c483,499
+< c ---------------------------------------------------
+< c 1.2   Initializations done at every physical timestep:
+< c ---------------------------------------------------
+---
+> !!!!!!!!!!!!!!!!TEST TEST
+> !      IF (nocalculphy) THEN
+> !
+> !            write(*,*) 'tendencies are not recalculated !'  
+> !            pdu(:,:)=spdu(:,:) 
+> !            pdv(:,:)=spdv(:,:)
+> !            pdt(:,:)=spdt(:,:)
+> !            pdq(:,:,:)=spdq(:,:,:)
+> !            pdpsrf(:)=spdpsrf(:)
+> !            write(*,*) pdu(100,10), pdv(100,10), pdt(100,10)  
+> !      ELSE      
+> !!!!!!!!!!!!!!!!TEST TEST
+> 
+> 
+> c    ------------------------------------------
+> c    Initialisations at every physical timestep:
+> c    ------------------------------------------
+502,503c509,525
+< c     Initialize various variables
+< c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+>       zday=pday+ptime
+> 
+> 
+> 
+> c     Computing Solar Longitude (Ls) :
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+>       if (season) then 
+>          PRINT*,'day',zday
+>          CALL solarlong(zday,zls)
+>       else
+>          PRINT*,'day_ini',day_ini
+>          call solarlong(float(day_ini),zls) 
+>       end if
+> 
+> 
+> c     Initializing various variable
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+514,526c536,537
+< 
+<       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     computing geopotentiel at interlayer levels
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+531c542
+<             zzlay(ig,l)=pphi(ig,l)/g
+---
+>             zzlay(ig,l)=pphi(ig,l)/g    
+549,550c560,561
+< c     Compute potential temperature
+< c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c     Computing potential temperature
+> c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+559,560c570,571
+< c    1.2.5 Compute mean mass, cp, and R
+< c    --------------------------------
+---
+> c    1.5 Calculation of mean mass, cp, and R
+> c    ---------------------------------------
+566,567c577,578
+< c    2. Compute radiative tendencies :
+< c------------------------------------
+---
+> c    2. Calcul of the radiative tendencies :
+> c    ---------------------------------------
+570c581
+<       IF (callrad) THEN
+---
+>       IF(callrad) THEN
+576a588
+>         
+597a610
+> 
+599,600c612,614
+<            IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+<      &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+---
+>            IF(MOD(iphysiq*(icount-1),day_step).EQ.0) THEN          
+>                 CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+>            ENDIF
+602,607d615
+< 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)
+609,610c617,618
+< c          Estimate the ice particle size distribution at firstcall:
+< c          --------------------------------------------------------
+---
+> c          Atmospheric dust opacity and aerosol distribution:
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+612,621d619
+< c
+< c **WRF: a verifier
+< c
+<            IF (firstcall.AND.activice) THEN
+<              CALL watercloud(ngrid,nlayer,ptimestep,
+<      &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+<      &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+<      &                nq,naerkind,taufirstcall,
+<      &                rnuclei,rice,nuice)
+<            ENDIF
+623,629c621,722
+< 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,
+---
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+> cc*****WRF
+>          CALL meso_dustopacity(ngrid,nlayer,nq,
+>      $          zday,pplay,pplev,zls,pq,
+>      $      tauref,tau,aerosol)
+> 
+> cc*****WRF
+> cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+> 
+>         
+> c          Calling main radiative transfer scheme
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c          Transfer through dust and CO2, except NIR CO2 absorption
+> 
+> c ----------
+> c partie rajoutee par Franck, commentee pour l'instant
+> c ----------
+> c
+> c           if (ngridmx.eq.1) pclc(1)=1. !TEST for 1D simulation
+> c
+> c           pclc_min=1.
+> c           if (activice.and.naerkind.gt.1) then
+> c             do ig=1,ngrid
+> c               pclc_min=min(pclc_min,pclc(ig))
+> c             enddo
+> c           endif
+> c
+> c           IF(activice.and.naerkind.gt.1.and.pclc_min.lt.1) THEN
+> c          Computing radiative tendencies accounting for a cloudy area (0< pclc(ngrid) <1)
+> c          pclc is set in initracer (prescribed for the moment).
+> c          two steps : 1/rad. tend. without clouds (aerosol(*,*,2)=0.)
+> c          ~~~~~~~~~   2/rad. tend. with clouds
+> c                      3/final tendencies=average of 1/ and 2/ weighted by the
+> cloud area (pclc)
+> c
+> c
+> c 1/
+> c           call zerophys(nlayer*ngrid,aerosol(1,1,2))  !remettre
+> c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+> c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+> c     $     cldtlw,cldtsw,clsurf_lw,clsurf_sw,cltop_lw,cltop_sw)
+> c
+> c 2/
+> c           CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+> c     $     tau,aerosol,zls,co2ice)
+> c
+> c           CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+> c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+> c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+> c
+> c 3/
+> c           do l=1,nlayer
+> c             do ig=1,ngrid
+> c             zdtlw(ig,l)=(1.-pclc(ig))*cldtlw(ig,l)+pclc(ig)*zdtlw(ig,l)
+> c             zdtsw(ig,l)=(1.-pclc(ig))*cldtsw(ig,l)+pclc(ig)*zdtsw(ig,l)
+> c             enddo
+> c           enddo
+> c           do ig=1,ngrid
+> c             fluxsurf_lw(ig)=(1.-pclc(ig))*clsurf_lw(ig)+
+> c     $        pclc(ig)*fluxsurf_lw(ig)
+> c             fluxtop_lw(ig)=(1.-pclc(ig))*cltop_lw(ig)+
+> c     $        pclc(ig)*fluxtop_lw(ig)
+> c
+> c             fluxsurf_sw(ig,1)=(1.-pclc(ig))*clsurf_sw(ig,1)+
+> c     $        pclc(ig)*fluxsurf_sw(ig,1)
+> c             fluxsurf_sw(ig,2)=(1.-pclc(ig))*clsurf_sw(ig,2)+
+> c     $        pclc(ig)*fluxsurf_sw(ig,2)
+> c
+> c             fluxtop_sw(ig,1)=(1.-pclc(ig))*cltop_sw(ig,1)+
+> c     $        pclc(ig)*fluxtop_sw(ig,1)
+> c             fluxtop_sw(ig,2)=(1.-pclc(ig))*cltop_sw(ig,2)+
+> c     $        pclc(ig)*fluxtop_sw(ig,2)
+> c           enddo
+> c
+> c           ELSE
+> c
+> c          Atmospheric water ice opacity and particle distribution:
+> c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c
+> c           if (activice.and.naerkind.gt.1)
+> c     &      CALL h2oiceopacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,
+> c     &      tau,aerosol,zls,co2ice)
+> c
+> c
+> c ----------
+> c  fin partie rajoutee par Franck (plus ENDIF ci-dessous)
+> c ----------
+> 
+> 
+> !          DO ig=1,ngrid
+> !            DO l=1,nlayer
+> !                   IF ( (pplev(ig,l+1) - pplev(ig,l) ) .gt. 0. )
+> !     .                PRINT*,'pb1 ',
+> !     .                        pplev(ig,l),
+> !     .                        pplev(ig,l+1),
+> !     .                        pplev(ig,l+1)-pplev(ig,l),
+> !     .                        l,
+> !     .                        ig
+> !            ENDDO
+> !         ENDDO
+> 
+>            CALL callradite(icount,ngrid,nlayer,aerosol,albedo,
+631,632c724,740
+<      $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+<      &     tauref,tau,aerosol,rice,nuice)
+---
+>      $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw)
+> 
+> !           DO ig=1,ngrid
+> !            zdtlw(ig)=zdtlw(1)
+> !            zdtsw(ig)=zdtsw(1)
+> !            fluxsurf_lw(ig)=fluxsurf_lw(1)
+> !            fluxsurf_sw(ig,1)=fluxsurf_sw(1,1)
+> !            fluxsurf_sw(ig,2)=fluxsurf_sw(1,2)
+> !            fluxtop_lw(ig)=fluxtop_lw(1)
+> !            fluxtop_sw(ig,1)=fluxtop_sw(1,1) 
+> !            fluxtop_sw(ig,2)=fluxtop_sw(1,2)
+> !           ENDDO
+> 
+> c ----------
+> c           ENDIF ! end of condition on the cloudy fraction
+> c ----------
+> 
+697a806
+> 
+701c810
+<                fluxrad_sky(ig)=emis(ig)*fluxsurf_lw(ig)
+---
+>                fluxrad_save(ig)=emis(ig)*fluxsurf_lw(ig)
+726a836,839
+>            !PRINT*,'zdtsw',zdtsw
+>            !PRINT*,'zdtlw',zdtlw
+>            !PRINT*,'zdtnirco2',zdtnirco2
+>            !PRINT*,'dtrad',dtrad
+729,731c842
+<         ENDIF ! of if(mod(icount-1,iradia).eq.0)
+< 
+< 
+---
+>         ENDIF ! mod(icount-1,iradia).eq.0
+734c845
+< c    -------------------------------------------
+---
+> c    -----------------------------------------------
+738d848
+< c
+743c853
+<                fluxrad(ig)=fluxrad_sky(ig)-zplanck(ig)
+---
+>                fluxrad(ig)=fluxrad_save(ig)-zplanck(ig)
+761c871
+<       ENDIF ! of IF (callrad)
+---
+>       ENDIF
+788d897
+<       IF (calldifv) THEN
+789a899
+>       IF(calldifv) THEN
+878c988
+<          if (tracer) then 
+---
+>          if(tracer) then 
+891c1001
+<          end if ! of if (tracer)
+---
+>          end if
+905c1015
+<       ENDIF ! of IF (calldifv)
+---
+>       ENDIF
+950c1060
+<       ENDIF ! of IF(calladj)
+---
+>       ENDIF
+956c1066
+<       IF (callcond) THEN
+---
+>       IF(callcond) THEN
+973,974d1082
+< !!!**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
+978c1086
+<          IF (tracer) THEN
+---
+>          IF(tracer) THEN
+986c1094
+<          ENDIF ! of IF (tracer)
+---
+>          END IF !(tracer)
+988c1096
+<       ENDIF  ! of IF (callcond)
+---
+>       ENDIF  !(callcond) 
+989a1098
+> c        print*,'condens ok'
+994c1103
+<       if (tracer) then 
+---
+>       if(tracer) then 
+1004,1008c1113
+< 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,
+---
+>            call watercloud(ngrid,nlayer, ptimestep,
+1010,1013c1115,1118
+<      &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+<      &                nq,naerkind,tau,
+<      &                rnuclei,rice,nuice)
+< c          if (activice) then
+---
+>      &                pq,pdq,zdqcloud,qsurf,zdqscloud,zdtcloud,
+>      &                nq,naerkind,tau,icount,zls)
+> 
+>            if (activice) then
+1015,1020c1120,1131
+< c          DO l=1,nlayer
+< c            DO ig=1,ngrid
+< c              pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+< c            ENDDO
+< c          ENDDO
+< c          endif
+---
+>            DO l=1,nlayer
+>              DO ig=1,ngrid
+>                pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+>              ENDDO
+>            ENDDO
+>            endif
+> 
+>            IF (iceparty) then
+>              iqmin=nq-1
+>            ELSE
+>              iqmin=nq
+>            ENDIF
+1022,1023c1133
+< ! increment water vapour and ice atmospheric tracers tendencies
+<            IF (water) THEN
+---
+>            DO iq=iqmin,nq
+1025,1030c1135,1137
+<                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
+---
+>                 DO ig=1,ngrid
+>                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+>                 ENDDO
+1032,1039c1139,1144
+<            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)
+---
+>              DO ig=1,ngrid
+>                 dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+>              ENDDO
+>            ENDDO
+> 
+>          END IF  ! (water)
+1047c1152
+<          IF (photochem .or. thermochem) then
+---
+>          IF(photochem .or. thermochem) then
+1049,1055c1154,1159
+<      &      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
+---
+>      .      zzlay,zday,pq,pdq,zdqchim,zdqschim,zdqcloud,zdqscloud)
+>            
+> c Photochemistry includes condensation of H2O2
+> 
+>            do iq=nqchem_min,nq
+>             if (noms(iq).eq."h2o2") then
+1058c1162,1163
+<                  pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
+---
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqcloud(ig,l,iq)
+1061,1063c1166
+<            ENDDO ! of DO iq=1,nq
+<            ! add condensation tendency for H2O2
+<            if (igcm_h2o2.ne.0) then
+---
+>             else
+1066,1067c1169
+<                  pdq(ig,l,igcm_h2o2)=pdq(ig,l,igcm_h2o2)
+<      &                                +zdqcloud(ig,l,igcm_h2o2)
+---
+>                     pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqchim(ig,l,iq)
+1070,1085c1172,1185
+<            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
+---
+>             endif
+>            ENDDO
+>            do iq=nqchem_min,nq
+>             if (noms(iq).eq."h2o2") then
+>                DO ig=1,ngrid
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqscloud(ig,iq)
+>                ENDDO
+>             else
+>                DO ig=1,ngrid
+>                     dqsurf(ig,iq)= dqsurf(ig,iq) + zdqschim(ig,iq)
+>                ENDDO
+>             endif
+>            ENDDO
+1087c1187,1188
+<          END IF  ! of IF (photochem.or.thermochem)
+---
+>          END IF  ! (photochem.or.thermochem)
+> c        print*,'photochem ok'
+1112c1213
+<            endif  ! of if (dustbin.ge.1)
+---
+>            endif  ! (test sur dustbin)
+1114c1215
+<          END IF ! of IF (callddevil)
+---
+>          END IF
+1129c1230
+<      &                pplev,zzlev, pt, rnuclei, rice,
+---
+>      &                pplev,zzlev, pt,
+1132a1234
+> 
+1145c1247,1249
+<          END IF   ! of IF (sedimentation)
+---
+>          END IF   ! (sedimentation)
+> 
+> c        print*,'sedim ok'
+1161c1265,1267
+<       endif !  of if (tracer) 
+---
+>       END IF    ! (tracer) 
+> 
+> c        print*,'tracers ok'
+1165c1271
+< c   8. THERMOSPHERE CALCULATION
+---
+> c   8.5 THERMOSPHERE CALCULATION
+1172a1279,1281
+> c           do iq=nqchem_min,nq
+> c           write(*,*) 'thermo iq,pq',iq,pq(690,1,iq)
+> c           enddo
+1187d1295
+<       endif ! of if (callthermos)
+1188a1297
+>       endif
+1190c1299
+< c   9. Surface  and sub-surface soil temperature
+---
+> c   8. Surface  and sub-surface soil temperature
+1194,1195c1303,1304
+< c   9.1 Increment Surface temperature:
+< c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c   Surface temperature incrementation :
+> c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1201,1203d1309
+< 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
+1205c1311,1314
+<       IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+---
+> c  Prescription piege froid au pole sud (Except at high obliquity !!)
+> c  temperature en surface = temperature equilibre de phases du CO2
+>        
+>       IF (tracer.AND.water.AND.ngridmx.NE.1) THEN
+1207,1210c1316
+<            ! 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)))
+---
+>            tsurf(ngrid)=1/(1/136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
+1219,1221c1325,1328
+<            if ((co2ice(ig).eq.0).and.
+<      &        (qsurf(ig,igcm_h2o_ice).gt.0.005)) then
+<               albedo(ig,1)=0.45                                     
+---
+> 
+> c       -------------- Version temporaire fit TES 2008 ------------
+>          if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+>               albedo(ig,1)=0.45
+1223c1330,1344
+<            endif
+---
+>           endif
+> 
+> c         if (co2ice(ig).eq.0.and.qsurf(ig,nqmx).gt.0.005) then
+> c           if (.not.watercaptag(ig)) then
+> c             albedo(ig,1)=0.4
+> c             albedo(ig,2)=0.4
+> c           endif
+> c         endif
+> c       -------------- version Francois ---------------
+> c          if (co2ice(ig).eq.0.and.
+> c    &        ((qsurf(ig,nqmx).gt.0.005).or.(watercaptag(ig)))) then
+> c              albedo(ig,1)=max(0.4,albedodat(ig))
+> c              albedo(ig,2)=albedo(ig,1)
+> c          endif
+> c       ---------------------------------------------
+1225c1346,1349
+<       ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+---
+>       ENDIF  ! of IF (tracer.AND.water.AND.ngridmx.NE.1)
+> 
+> 
+> c        print*,'tracer, water and 3D ok'
+1228,1229c1352,1353
+< c   9.2 Compute soil temperatures and subsurface heat flux:
+< c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c   soil temperatures and subsurface heat flux:
+> c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1232c1356
+<      &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+---
+>      s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+1234a1359,1364
+> c        print*,'soil ok'
+> 
+> 
+> 
+> 
+> 
+1236,1237c1366,1367
+< c  10. Write output files
+< c  ----------------------
+---
+> c  9. Writing output files
+> c  ------------------------
+1243c1373
+<       ! temperature, zonal and meridional wind
+---
+> 
+1251,1252d1380
+< 
+<       ! tracers
+1260,1261d1387
+< 
+<       ! surface pressure
+1263c1389
+<           ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+---
+>           ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep !already in 7
+1265,1266d1390
+< 
+<       ! pressure
+1273,1274c1397
+< 
+<       ! Density 
+---
+>       ! Density calculation
+1281,1286d1403
+< 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
+< 
+1289,1290c1406,1407
+< 	     fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+< 	     fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+---
+>             fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+>             fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+1292c1409
+< c ******* TEST ******************************************************
+---
+> c ******* TEMPORAIRE ************************************************
+1303,1304c1420,1421
+<       if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then	
+<         write(*,*) 'PHYSIQ: stability WARNING :'
+---
+>       if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then
+>         write(*,*) 'stability WARNING :' 
+1310,1312c1427,1430
+< c     ---------------------
+< c     Outputs to the screen 
+< c     ---------------------
+---
+> c     --------------------
+> c     Output on the screen 
+> c     --------------------
+> 
+1327c1445
+<       ENDIF ! of IF (lwrite)
+---
+>       ENDIF
+1328a1447,1457
+> cc****WRF
+> cc      IF (ngrid.NE.1) THEN
+> c	PRINT*,'check - values after update at ngrid/2+1'
+> c         WRITE(*,'(a4,a6,2a10)') 'l','u','v','T'
+> c         WRITE(*,'(i4,3f10.5)') (l,
+> c     s   zu(igout,l),
+> c     s   zv(igout,l),
+> c     s   zt(igout,l),
+> c     s   l=1,nlayer)
+> c
+> cc****WRF
+1330d1458
+<       IF (ngrid.NE.1) THEN
+1332,1333c1460,1462
+<      &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2),
+<      &   ' tau(Viking1) =',tau(ig_vl1,1)
+---
+>      &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)
+> c     &   ' tau(Viking1) =',tau(ig_vl1,1)
+> 
+1338,1342c1467,1472
+< 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
+---
+> c        Remarque : On  stocke restarfi 
+> c        juste avant que la dynamique ne le soit dans restart.
+> c        entre maintenant et l'ecriture de restart,
+> c        on aura itau = itau +1 et remise a jour de time.
+> c        (lastcall = .true. lorsque itau+1 = itaufin)
+> c        Donc on stocke  avec time = time + dtvr
+1346c1476
+<             write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+---
+>             write(*,*)'pour physdem ztime_fin =',ztime_fin
+1354,1357d1483
+< c        -------------------------------------------------------------------
+< c        Calculation of diagnostic variables written in both stats and
+< c          diagfi files
+< c        -------------------------------------------------------------------
+1359,1360c1485,1529
+<          if (tracer) then
+<            if (water) then
+---
+> 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)
+1362,1671d1530
+<              call zerophys(ngrid,mtot)
+<              call zerophys(ngrid,icetot)
+<              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
+< 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)-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))
+<                  tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+<                enddo
+<              enddo
+< 
+<            endif ! of if (water)
+<          endif ! of if (tracer)
+< 
+< c        -----------------------------------------------------------------
+< c        WSTATS: Saving statistics
+< c        -----------------------------------------------------------------
+< c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+< c        which can later be used to make the statistic files of the run:
+< c        "stats")          only possible in 3D runs !
+< 
+<          
+<          IF (callstats) THEN
+< 
+<            call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
+<            call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+<            call wstats(ngrid,"co2ice","CO2 ice cover",
+<      &                "kg.m-2",2,co2ice)
+<            call wstats(ngrid,"fluxsurf_lw",
+<      &                "Thermal IR radiative flux to surface","W.m-2",2,
+<      &                fluxsurf_lw)
+<            call wstats(ngrid,"fluxsurf_sw",
+<      &                "Solar radiative flux to surface","W.m-2",2,
+<      &                fluxsurf_sw_tot)
+<            call wstats(ngrid,"fluxtop_lw",
+<      &                "Thermal IR radiative flux to space","W.m-2",2,
+<      &                fluxtop_lw)
+<            call wstats(ngrid,"fluxtop_sw",
+<      &                "Solar radiative flux to space","W.m-2",2,
+<      &                fluxtop_sw_tot)
+<            call wstats(ngrid,"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
+< 
+< 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,' local tau =',tau(1,1)
+< 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')
+<          CALL writeg1d(ngrid,1,ps,'ps','Pa')
+<          
+<          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')
+< 
+<          if(tracer) then
+< c           CALL writeg1d(ngrid,1,tau,'tau','SI')
+<             do iq=1,nq
+<               CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+<             end do
+<          end if
+1673,1684c1532
+<          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
+---
+>       icount=icount+1
+1686c1534,1536
+<       END IF       ! if(ngrid.ne.1)
+---
+> !!!!!!!!!!!!!TEST TEST
+> !        ENDIF
+> !!!!!!!!!!!!!TEST TEST      
+1688c1538
+<       icount=icount+1
+---
+>       write(*,*) 'now, back to the dynamical core...'
+3,4d2
+< ! to use  'getin'
+<       USE ioipsl_getincom 
+15d12
+< c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
+31d27
+< #include "comsoil.h"
+43a40
+> #include "fisice.h"
+45d41
+< #include "advtrac.h"
+50a47
+>       INTEGER unit           ! unite de lecture de "testphys1d.def"
+89d85
+<       integer :: nq=1 ! number of tracers
+92d87
+<       character (len=7) :: str7
+142c137
+< c  Lecture des parametres dans "run.def" 
+---
+> c  Lecture des parametres dans "testphys1d.def" 
+145,156c140,148
+< 
+< ! 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 ...'
+---
+> c   Opening parameters file "testphys1d.def"
+> c   ---------------------------------------
+>       unit =97
+>       OPEN(unit,file='testphys1d.def',status='old',form='formatted'
+>      .     ,iostat=ierr)
+> 
+>       IF(ierr.ne.0) THEN
+>         write(*,*) 'Problem to open "testphys1d.def'
+>         write(*,*) 'Is it there ?'
+158,212c150
+<       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='run.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)
+<       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)
+---
+>       END IF
+217,219c155,157
+<       day0 = 0 ! default value for day0
+<       write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+<       call getin("day0",day0)
+---
+>       day0 = 0
+>       PRINT *,'date de depart ?'
+>       READ(unit,*) day0
+221c159
+<       write(*,*) " day0 = ",day0
+---
+>       PRINT *,day0
+223,227c161,163
+<       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
+---
+>       PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
+>       READ(unit,*) time
+>       time=time/24.E+0
+235,244c171,177
+< 
+<       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
+---
+>       PRINT *,'nombre de pas de temps par jour ?'
+>       READ(unit,*) day_step
+>       print*,day_step
+> 
+>       PRINT *,'nombre de jours simules ?'
+>       READ(unit,*) ndt
+>       print*,ndt
+251,254c184,186
+<       psurf=610. ! default value for psurf
+<       PRINT *,'Surface pressure (Pa) ?'
+<       call getin("psurf",psurf)
+<       write(*,*) " psurf = ",psurf
+---
+>       PRINT *,'pression au sol'
+>       READ(unit,*) psurf
+>       PRINT *,psurf
+261,264c193,195
+<       tauvis=0.2 ! default value for tauvis
+<       print *,'Reference dust opacity at 700 Pa ?'
+<       call getin("tauvis",tauvis)
+<       write(*,*) " tauvis = ",tauvis
+---
+>       print *,'epaisseur optique dans le visible ?'
+>       READ(unit,*) tauvis
+>       print *,tauvis
+268,271c199,201
+<       lati(1)=0 ! default value for lati(1)
+<       PRINT *,'latitude (in degrees) ?'
+<       call getin("latitude",lati(1))
+<       write(*,*) " latitude = ",lati(1)
+---
+>       PRINT *,'latitude en degres ?'
+>       READ(unit,*) lati(1)
+>       PRINT *,lati(1)
+279,287c209,215
+<       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)
+---
+>       PRINT *,'Albedo du sol nu ?'
+>       READ(unit,*) albedodat(1)
+>       PRINT *,albedodat(1)
+> 
+>       PRINT *,'Inertie thermique du sol ?'
+>       READ(unit,*) inertiedat(1)
+>       PRINT *,inertiedat(1)
+322,330c250,253
+<       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
+---
+>       PRINT *,'composante vers l est du vent geostrophique (U) ?'
+>       READ(unit,*) gru
+>       PRINT *,'composante vers le nord du vent geostrophique (V) ?'
+>       READ(unit,*) grv
+345,348c268,270
+<       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
+---
+>       co2ice=0.E+0
+>       PRINT *,'co2ice (kg.m-2)'
+>       READ(unit,*) co2ice
+355,356c277,278
+<          emis=emisice(1) ! northern hemisphere
+<          IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
+---
+>          emis=emisice(1)
+>          IF(lati(1).LT.0) emis=emisice(2)
+366d287
+<       hybrid=.true.
+368,369c289,290
+<       call getin("hybrid",hybrid)
+<       write(*,*) " hybrid = ", hybrid
+---
+>       READ(unit,*) hybrid
+>       PRINT *,'Hybrid =', hybrid
+396,397c317
+< 
+<       call profile(nlayer+1,tmp1,tmp2)
+---
+>       call profile(unit,nlayer+1,tmp1,tmp2)
+406,408c326,327
+< ! Initialize soil properties and temperature
+< ! ------------------------------------------
+<       volcapa=1.e6 ! volumetric heat capacity
+---
+> c     temperature du sous-sol
+> c     ~~~~~~~~~~~~~~~~~~~~~~~
+410,411c329
+<          inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+<          tsoil(isoil)=tsurf  ! soil temperature
+---
+>          tsoil(isoil)=tsurf
+414,422d331
+< ! 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
+< 
+437c346
+<      $   thermo,qsurf)
+---
+>      $   thermo)
+567,573d475
+< !       increment tracer values
+<         DO iq = 1, nqmx
+<           DO ilayer=1,nlayer
+<              q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+<           ENDDO
+<         ENDDO
+< 
+598a501,504
+>       subroutine iniwrite
+>       RETURN
+>       END
+>  
+15,17c15,17
+< #include "dimensions.h"
+< #include "statto.h"
+< #include "netcdf.inc"
+---
+> include "dimensions.h"
+> include "statto.h"
+> include "netcdf.inc"
+32c32
+< !integer :: latid,lonid,altid,timeid
+---
+> integer :: latid,lonid,altid,timeid
+34c34
+< !integer, dimension(4) :: dimout
+---
+> integer, dimension(4) :: dimout
+100,103c100,103
+< !      dimout(1)=lonid
+< !      dimout(2)=latid
+< !      dimout(3)=altid
+< !      dimout(4)=timeid
+---
+>       dimout(1)=lonid
+>       dimout(2)=latid
+>       dimout(3)=altid
+>       dimout(4)=timeid
+131,133c131,133
+< !      dimout(1)=lonid
+< !      dimout(2)=latid
+< !      dimout(3)=timeid
+---
+>       dimout(1)=lonid
+>       dimout(2)=latid
+>       dimout(3)=timeid
+64a65,66
+> #include "fisice.h"
+> 
+107c109
+<       REAL zcondicea(ngridmx,nlayermx)
+---
+> c      REAL zcondicea(ngridmx,nlayermx) ! Already defined in fisice.h 
+127,135c129
+<       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
+---
+> 
+139c133
+<       real qco2min,qco2,mmean
+---
+>       real qco2min
+148,149c142
+<       real m_co2, m_noco2, A , B
+<       save A, B, m_co2, m_noco2
+---
+>  
+155a149,152
+> c      common/scratch/zt,ztcond,zcondicea,zfallice,tconda1
+> c     ,    ,tconda2,zdtsig,zdt,zu,zv
+> 
+> 
+164a162
+> 
+174,175d171
+<          write(*,*) 'Newcondens: improved_ztcond=',improved_ztcond
+<          write(*,*) 'Newcondens: bound_qco2=',bound_qco2
+177c173
+<          PRINT*,'acond,bcond,ccond',acond,bcond,ccond
+---
+>          PRINT*,'acond,bcond,ccond',acond,bcond,acond
+180,181c176
+< !         if (improved_ztcond.and.tracer) then  
+<          if (tracer) then
+---
+>          if (tracer) then  
+184,194c179
+<              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
+---
+>              if (noms(iq).eq."co2") ico2=iq
+200a186
+> 
+248,266d233
+< 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
+< 
+273,275c240
+< !            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)))
+---
+>             ztcond(ig,l)=1./(bcond-acond*log(.0095*pplay(ig,l)))
+319,320c284
+<          ztcondsol(ig)=
+<      &          1./(bcond-acond*log(.01*vmr_co2(ig,1)*pplev(ig,1)))
+---
+>          ztcondsol(ig)=1./(bcond-acond*log(.0095*pplev(ig,1)))
+578,600c542,564
+< c           Tendencies on T, U, V, Q 
+< c           """"""""""""""""""""""""
+<             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
+---
+> cc           Tendencies on T, U, V, Q 
+> cc           """"""""""""""""""""""""
+> c            DO l=1,nlayer
+> c 
+> cc             Tendencies on T
+> c               zdtsig(ig,l) = (1/masse(l)) *
+> c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+> c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+> c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+> c               pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+> c
+> cc             Tendencies on U
+> c               pduc(ig,l)   = (1/masse(l)) *
+> c     &        ( zmflux(l)*(zum(l) - zu(l))
+> c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+> c
+> c
+> cc             Tendencies on V
+> c               pdvc(ig,l)   = (1/masse(l)) *
+> c     &        ( zmflux(l)*(zvm(l) - zv(l))
+> c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+> c
+> c            END DO
+604,605c568
+< !              if (noms(iq).eq.'co2') then 
+<               if (iq.eq.ico2) then 
+---
+>               if (noms(iq).eq.'co2') then 
+705,734c668,674
+< ! 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
+---
+> 
+>         !print*,'fin newcondens piceco2',piceco2(ig)
+>         !print*,'ptsrf ztsrf', ptsrf(ig),ztsrf(ig)
+>         !print*,'ztcondsol(ig)', ztcondsol(ig)
+>         !print*,'ztcondsol(ig)', ztcondsol(ig)
+>         !print*,'tend. press', pdpsrf(ig)*ptimestep
+> 
+1c1
+<       SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+---
+>       SUBROUTINE newsedim(ngrid,nlay,nsize,ptimestep,
+23c23
+<       INTEGER ngrid,nlay,naersize
+---
+>       INTEGER ngrid,nlay,nsize
+29c29
+<       real rd(naersize)             ! particle radius (m)
+---
+>       real rd(nsize)             ! particle radius (m)
+114c114
+<             if (naersize.eq.1) then 
+---
+>             if (nsize.eq.1) then 
+164a165
+> cccccc g95: XOR does not exist in Fortran  
+174a176
+> cccccc g95: XOR does not exist in Fortran
+184a187
+> cccccc g95: XOR does not exist in Fortran
+194a198
+> cccccc g95: XOR does not exist in Fortran
+358c362
+<       WRITE(*,*) 'OROSETUP: KKNUB=KKNUL= ',KKNUB(JL),' AT JL= ',JL
+---
+>       WRITE(*,*) 'KKNUB=KKNUL= ',KKNUB(JL),' AT JL= ',JL
+4c4
+<       implicit none
+---
+>       IMPLICIT none
+10d9
+< #include "netcdf.inc"
+11a11
+> #include "netcdf.inc"
+19,20d18
+< !#include "tracer.h"
+< #include"advtrac.h"
+21a20
+>       CHARACTER*(*) fichnom
+24,42d22
+< !======================================================================
+< !  Arguments:
+< !  ---------
+< !  inputs:
+<       character*(*) fichnom ! "startfi.nc" file
+<       integer tab0
+<       integer Lmodif
+<       integer nsoil ! # of soil layers
+<       integer nq
+<       integer day_ini
+<       real time
+< 
+< !  outputs:
+<       real tsurf(ngridmx,nbsrf) ! surface temperature
+<       real tsoil(ngridmx,nsoil,nbsrf) ! soil temperature
+<       real emis(ngridmx) ! surface emissivity
+<       real q2(ngridmx, llm+1) ! 
+<       real qsurf(ngridmx,nq) ! tracers on surface
+<       real co2ice(ngridmx) ! co2 ice cover
+44,45c24,27
+< !======================================================================
+< !  Local variables:
+---
+>       INTEGER radpas
+>       REAL co2_ppm
+>       REAL solaire,time
+>       REAL tsoil(ngridmx,nsoil,nbsrf)
+47,51c29
+< !      INTEGER radpas
+< !      REAL co2_ppm
+< !      REAL solaire
+< 
+<       real xmin,xmax ! to display min and max of a field
+---
+>       REAL xmin, xmax
+52a31
+>       INTEGER nsoil,nq
+55,58c34,36
+<       INTEGER ierr, i, nsrf
+< !      integer isoil 
+< !      INTEGER length
+< !      PARAMETER (length=100)
+---
+>       INTEGER ierr, i, nsrf, isoil 
+>       INTEGER length
+>       PARAMETER (length=100)
+63,71c41,46
+<       REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+<       INTEGER nqold
+< 
+< ! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
+<       logical :: oldtracernames=.false.
+<       integer :: count
+<       character(len=30) :: txt ! to store some text
+< 
+<  
+---
+>       integer   Lmodif,tab0
+>       REAL      p_rad,p_omeg,p_g,p_mugaz,p_daysec
+>       REAL tsurf(ngridmx,nbsrf),co2ice(ngridmx),emis(ngridmx)
+>       REAL q2(ngridmx, llm+1)
+>       REAL qsurf(ngridmx,nq) 
+>       INTEGER day_ini,nqold
+75c50
+< 
+---
+>  
+82,103d56
+< ! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+< !                    qsurf02, ...)
+<       count=0
+<       do iq=1,nqmx
+<         txt= " "
+<         write(txt,'(a5,i2.2)')'qsurf',iq
+<         ierr=NF_INQ_VARID(nid,txt,nvarid)
+<         if (ierr.ne.NF_NOERR) then
+<           ! did not find old tracer name
+<           exit ! might as well stop here
+<         else
+<           ! found old tracer name
+<           count=count+1
+<         endif
+<       enddo
+<       if (count.eq.nqmx) then
+<         write(*,*) "phyetat0:tracers seem to follow old naming ",
+<      &             "convention (qsurf01,qsurf02,...)"
+<         write(*,*) "   => will work for now ... "
+<         write(*,*) "      but you should run newstart to rename them"
+<         oldtracernames=.true.
+<       endif
+213,231c166,184
+< !      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+< !      IF (ierr.NE.NF_NOERR) THEN
+< !         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+< !         CALL abort
+< !      ENDIF
+< !#ifdef NC_DOUBLE
+< !      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
+< !#else
+< !      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+< !#endif
+< !      IF (ierr.NE.NF_NOERR) THEN
+< !         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+< !         CALL abort
+< !      ENDIF
+< !      xmin = 1.0E+20
+< !      xmax = -1.0E+20
+< !      xmin = MINVAL(inertiedat)
+< !      xmax = MAXVAL(inertiedat)
+< !      PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
+---
+>       ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+>       IF (ierr.NE.NF_NOERR) THEN
+>          PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+>          CALL abort
+>       ENDIF
+> #ifdef NC_DOUBLE
+>       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
+> #else
+>       ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+> #endif
+>       IF (ierr.NE.NF_NOERR) THEN
+>          PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+>          CALL abort
+>       ENDIF
+>       xmin = 1.0E+20
+>       xmax = -1.0E+20
+>       xmin = MINVAL(inertiedat)
+>       xmax = MAXVAL(inertiedat)
+>       PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
+435,466c388,419
+< !      IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
+< !         PRINT*, "Trop de couches ou sous-mailles"
+< !         CALL abort
+< !      ENDIF
+< !      DO nsrf = 1, nbsrf
+< !         DO isoil=1, nsoil
+< !            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+< !            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+< !            IF (ierr.NE.NF_NOERR) THEN
+< !               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+< !               PRINT*, "          Il prend donc la valeur de surface"
+< !               DO i=1, ngridmx
+< !                  tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
+< !               ENDDO
+< !            ELSE
+< !#ifdef NC_DOUBLE
+< !              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
+< !#else
+< !              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+< !#endif
+< !               IF (ierr.NE.NF_NOERR) THEN
+< !                  PRINT*, "Lecture echouee pour <tsoil>"
+< !                  CALL abort
+< !               ENDIF
+< !            ENDIF
+< !         ENDDO
+< !      ENDDO
+< !      xmin = 1.0E+20
+< !      xmax = -1.0E+20
+< !      xmin = MINVAL(tsoil)
+< !      xmax = MAXVAL(tsoil)
+< !      PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
+---
+>       IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
+>          PRINT*, "Trop de couches ou sous-mailles"
+>          CALL abort
+>       ENDIF
+>       DO nsrf = 1, nbsrf
+>          DO isoil=1, nsoil
+>             WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+>             ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+>             IF (ierr.NE.NF_NOERR) THEN
+>                PRINT*, "phyetat0: Le champ <tsoil> est absent"
+>                PRINT*, "          Il prend donc la valeur de surface"
+>                DO i=1, ngridmx
+>                   tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
+>                ENDDO
+>             ELSE
+> #ifdef NC_DOUBLE
+>               ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
+> #else
+>               ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+> #endif
+>                IF (ierr.NE.NF_NOERR) THEN
+>                   PRINT*, "Lecture echouee pour <tsoil>"
+>                   CALL abort
+>                ENDIF
+>             ENDIF
+>          ENDDO
+>       ENDDO
+>       xmin = 1.0E+20
+>       xmax = -1.0E+20
+>       xmin = MINVAL(tsoil)
+>       xmax = MAXVAL(tsoil)
+>       PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
+518,552c471,490
+< !            str7(1:5)='qsurf'
+< !            WRITE(str7(6:7),'(i2.2)') iq
+< !            ierr = NF_INQ_VARID (nid,str7,nvarid)
+<            IF (oldtracernames) THEN
+<              txt=" "
+<              write(txt,'(a5,i2.2)')'qsurf',iq
+<            ELSE
+<              txt=tnom(iq)
+<              if (txt.eq."h2o_vap") then
+<                ! There is no surface tracer for h2o_vap;
+<                ! "h2o_ice" should be loaded instead
+<                txt="h2o_ice"
+<                write(*,*) 'phyetat0: loading surface tracer',
+<      &                     ' h2o_ice instead of h2o_vap'
+<              endif
+<            ENDIF ! of IF (oldtracernames) THEN
+<            ierr=NF_INQ_VARID(nid,txt,nvarid)
+<            IF (ierr.NE.NF_NOERR) THEN
+<              write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
+<      &                  ' not found in file'
+<              write(*,*) trim(txt), ' set to 0'
+<              do ig=1,ngridmx
+<                qsurf(ig,iq)=0.
+<              end do
+<              nqold=min(iq-1,nqold)
+<            ELSE
+< #ifdef NC_DOUBLE
+<              ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+< #else
+<              ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+< #endif
+<              IF (ierr.NE.NF_NOERR) THEN
+<                PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
+<                CALL abort
+<              ENDIF
+---
+>             str7(1:5)='qsurf'
+>             WRITE(str7(6:7),'(i2.2)') iq
+>             ierr = NF_INQ_VARID (nid,str7,nvarid)
+>             IF (ierr.NE.NF_NOERR) THEN
+>                 write (*,*) ' WARNING : ',str7,' not in the file'
+>                 write (*,*) str7, ' set to 0'
+>                 do ig=1,ngridmx
+>                     qsurf(ig,iq)=0.
+>                 end do
+>                 nqold=min(iq-1,nqold)
+>             ELSE
+> #ifdef NC_DOUBLE
+>               ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+> #else
+>               ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+> #endif
+>               IF (ierr.NE.NF_NOERR) THEN
+>                 PRINT*, 'phyetat0: Lecture echouee pour <',str7,'>'
+>                 CALL abort
+>               ENDIF
+558c496
+<            PRINT*,'tracer on surface <',trim(txt),'>:',xmin,xmax
+---
+>       PRINT*,'tracer on surface <',str7,'>:', xmin, xmax
+560c498
+<          if ((nqold.lt.nq).and.(nqold.ge.1)) then
+---
+>          if(nqold.lt.nq) then
+583,587d520
+< 
+< ! Call to soil_settings, in order to read soil temperatures,
+< ! as well as thermal inertia and volumetric heat capacity
+< 
+<       call soil_settings(nid,ngridmx,nsoil,tsurf,tsoil)
+6c6
+<       implicit none
+---
+>       IMPLICIT none
+7a8,12
+> C Author : L. Fairhead
+> C Date   : 01/10/1999
+> C Objet  : Ecriture des etats initiaux physiques
+> c-------------------------------------------------------------
+> c
+9d13
+< c create physics (re-)start data file "restartfi.nc"
+24,25d27
+< #include"advtrac.h"
+< #include"callkeys.h"
+40c42
+< !      REAL champhys(ngridmx)
+---
+>       REAL champhys(ngridmx)
+48,49c50,58
+< !      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
+< !      EXTERNAL exner_hyb , SSUM
+---
+> ccccccccccccccccccccc g95 errors
+> ccc probably looking for functions, 
+> ccc but disappointed when finding subroutines 
+> ccc
+> ccc obsolete
+> ccc
+> ccc      
+> c      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
+> c      EXTERNAL exner_hyb , SSUM
+50a60,61
+> ccccccccccccccccccccc g95 errors
+> 
+56d66
+< #include "comsoil.h"
+65c75
+<       real alb(ngridmx),ith(ngridmx,nsoil)
+---
+>       real alb(ngridmx),ith(ngridmx)
+72,78d81
+< ! flag which identifies if we are using old tracer names (qsurf01,...)
+<       logical :: oldtracernames=.false.
+<       integer :: count
+<       character(len=30) :: txt ! to store some text
+< ! indexes of water vapour & water ice tracers (if any):
+<       integer :: i_h2o_vap=0
+<       integer :: i_h2o_ice=0
+81d83
+<       ! copy airefi(:) to area(:)
+83,84d84
+<       ! note: area() is defined in comgeomfi.h
+< 
+86,91c86,92
+<          albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat.h
+<          zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat.h
+<          zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat.h
+<          zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat.h
+<          zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat.h
+<          zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat.h
+---
+>          albedodat(ig)=alb(ig)
+>          inertiedat(ig)=ith(ig)
+>          zmea(ig)=pzmea(ig)
+>          zstd(ig)=pzstd(ig)
+>          zsig(ig)=pzsig(ig)
+>          zgam(ig)=pzgam(ig)
+>          zthe(ig)=pzthe(ig)
+93,94d93
+< 
+<       inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil.h
+96c95
+< c  things to store in the physics start file:
+---
+> c  stockage sur le fichier Physique:
+98c97
+<       ierr = NF_CREATE(adjustl(filename),NF_CLOBBER, nid)
+---
+>       ierr = NF_CREATE(trim((filename)),NF_CLOBBER, nid)
+100,101c99,100
+<         WRITE(6,*)'physdem1: Problem creating file ',adjustl(filename)
+<         write(6,*) NF_STRERROR(ierr)
+---
+>         WRITE(6,*)' Problem creating restartfi.nc'
+>         WRITE(6,*)' ierr = ', ierr
+105,106c104,105
+<       ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
+<      .                       "Physics start file")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 26,
+>      .                       "Fichier demarrage physique")
+109,114d107
+<       if (ierr.ne.NF_NOERR) then
+<         WRITE(6,*)'physdem1: Problem defining index dimension'
+< 	write(6,*) NF_STRERROR(ierr)
+<         call abort
+<       endif
+< c
+116,121d108
+<       if (ierr.ne.NF_NOERR) then
+<         WRITE(6,*)'physdem1: Problem defining physical_points dimension'
+< 	write(6,*) NF_STRERROR(ierr)
+<         call abort
+<       endif
+< c
+123,136c110
+<       if (ierr.ne.NF_NOERR) then
+<       WRITE(6,*)'physdem1: Problem defining subsurface_layers dimension'
+< 	write(6,*) NF_STRERROR(ierr)
+<         call abort
+<       endif
+< c
+< !      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
+<       ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
+<       if (ierr.ne.NF_NOERR) then
+<         WRITE(6,*)'physdem1: Problem defining nlayer+1 dimension'
+<         write(6,*) NF_STRERROR(ierr)
+< 	call abort
+<       endif
+< c
+---
+>       ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
+138,146c112,114
+<       if (ierr.ne.NF_NOERR) then
+<         WRITE(6,*)'physdem1: Problem defining advected fields dimension'
+<         WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
+<         write(6,*) NF_STRERROR(ierr)
+<       endif
+< 
+<       ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
+< 
+< c clear tab_cntrl(:) array
+---
+> c
+>       ierr = NF_ENDDEF(nid)
+> c
+151c119
+<       write(*,*) "physdem1: ngridmx: ",ngridmx
+---
+>       write(*,*) "ngridmx: ",ngridmx
+154c122
+< c Fill control array tab_cntrl(:) with paramleters for this run
+---
+> c pour la DOCUMENTATION    (fichier io/maj/fi_cntl)
+156,166c124,134
+< c Informations on the physics grid
+<       tab_cntrl(1) = float(ngridmx)  ! number of nodes on physics grid
+<       tab_cntrl(2) = float(nlayermx) ! number of atmospheric layers
+<       tab_cntrl(3) = day_ini + int(time)         ! initial day 
+<       tab_cntrl(4) = time -int(time)            ! initiale time of day
+< 
+< c Informations about Mars, used by dynamics and physics
+<       tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
+<       tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
+<       tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
+<       tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
+---
+> c Info sur la grille physique
+>       tab_cntrl(1) = float(ngridmx)  ! nombre de points de la grille physique
+>       tab_cntrl(2) = float(nlayermx) ! nombre de couches
+>       tab_cntrl(3) = day_ini + int(time)         ! jour initial
+>       tab_cntrl(4) = time -int(time)            ! heure initiale 0
+> 
+> c Info sur la Planete Mars pour la dynamique et la physique
+>       tab_cntrl(5) = rad      ! rayon de mars(m) ~3397200
+>       tab_cntrl(6) = omeg     ! vitesse de rotation (rad.s-1)
+>       tab_cntrl(7) = g        ! gravite (m.s-2) ~3.72
+>       tab_cntrl(8) = mugaz    ! Masse molaire de l''atm (g.mol-1) ~43.49
+168c136
+<       tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
+---
+>       tab_cntrl(10) = daysec  ! duree du sol (s)  ~88775
+170c138
+<       tab_cntrl(11) = phystep  ! time step in the physics
+---
+>       tab_cntrl(11) = phystep  ! pas de temps de la physique 
+174,179c142,147
+< c Informations about Mars, only for physics
+<       tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
+<       tab_cntrl(15) = periheli  ! min. Sun-Mars distance (Mkm) ~206.66
+<       tab_cntrl(16) = aphelie   ! max. SUn-Mars distance (Mkm) ~249.22
+<       tab_cntrl(17) = peri_day  ! date of perihelion (sols since N. spring)
+<       tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
+---
+> c Info sur la Planete Mars pour la physique uniquement
+>       tab_cntrl(14) = year_day  ! duree de l''annee (sols) ~668.6
+>       tab_cntrl(15) = periheli  ! dist.min. soleil-mars (Mkm) ~206.66
+>       tab_cntrl(16) = aphelie   ! dist.max. soleil-mars (Mkm) ~249.22
+>       tab_cntrl(17) = peri_day  ! date du perihelie (sols depuis printemps)
+>       tab_cntrl(18) = obliquit  ! Obliquite de la planete (deg) ~23.98
+181c149
+< c Boundary layer and turbulence
+---
+> c Couche limite et Turbulence
+183,184c151,152
+<       tab_cntrl(20) = lmixmin   ! mixing length ~100
+<       tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
+---
+>       tab_cntrl(20) = lmixmin   ! longueur de melange ~100
+>       tab_cntrl(21) = emin_turb ! energie minimale ~1.e-8
+186,191c154,159
+< c Optical properties of polar caps and ground emissivity
+<       tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
+<       tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
+<       tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
+<       tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
+<       tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
+---
+> c propriete optiques des calottes et emissivite du sol
+>       tab_cntrl(22) = albedice(1)  ! Albedo calotte nord ~0.5
+>       tab_cntrl(23) = albedice(2)  ! Albedo calotte sud ~0.5
+>       tab_cntrl(24) = emisice(1)   ! Emissivite calotte nord ~0.95
+>       tab_cntrl(25) = emisice(2)   ! Emissivite calotte sud ~0.95
+>       tab_cntrl(26) = emissiv      ! Emissivite du sol martien ~.95
+197,198c165,166
+< c dust aerosol properties
+<       tab_cntrl(27) = tauvis      ! mean visible optical depth
+---
+> c Proprietes des poussiere aerosol
+>       tab_cntrl(27) = tauvis      ! profondeur optique visible moyenne
+204,215c172,175
+< ! Soil properties:
+<       tab_cntrl(35) = volcapa ! soil volumetric heat capacity
+<       
+< c
+< !      write(*,*) "physdem1: tab_cntrl():",tab_cntrl
+<       
+<       ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+<       IF (ierr.NE.NF_NOERR) THEN
+<          PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+<          CALL abort
+<       ENDIF
+<       ! define variable
+---
+> cc   ***    new_oliq   (  commentaires de L. LI dans routine physique ) 
+> cc   ***  ok_orodr  et ok_orolf   si on appelle l'orographie      ****
+> c
+>       ierr = NF_REDEF (nid)
+221,236c181,183
+<       IF (ierr.NE.NF_NOERR) THEN
+<          PRINT*, 'physdem1: Failed to define controle'
+<          CALL abort
+<       ENDIF
+<       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+<      .                        "Control parameters")
+<       IF (ierr.NE.NF_NOERR) THEN
+<          PRINT*, 'physdem1: Failed to define controle title attribute'
+<          CALL abort
+<       ENDIF
+<       ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+<       IF (ierr.NE.NF_NOERR) THEN
+<          PRINT*, 'physdem1: Failed to swich out of NetCDF define mode'
+<          CALL abort
+<       ENDIF
+<       ! write variable
+---
+>       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
+>      .                        "Parametres de controle")
+>       ierr = NF_ENDDEF(nid)
+242,265d188
+<       IF (ierr.NE.NF_NOERR) THEN
+<          PRINT*, 'physdem1: Failed to write controle data'
+<          CALL abort
+<       ENDIF
+< 
+< ! write mid-layer depths mlayer() !known from comsoil.h
+< 
+<       ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+<       ! define variable
+< #ifdef NC_DOUBLE
+<       ierr = NF_DEF_VAR (nid,"soildepth",NF_DOUBLE,1,idim3,nvarid)
+< #else
+<       ierr = NF_DEF_VAR (nid,"soildepth",NF_FLOAT,1,idim3,nvarid)
+< #endif
+<       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+<      .                        "Soil mid-layer depth")
+<       ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+<       ! write variable
+< #ifdef NC_DOUBLE
+<       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+< #else
+<       ierr = NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+< #endif
+< 
+267d189
+< 
+274,275c196,197
+<       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
+<      .                        "Longitudes of physics grid")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
+>      .                        "Longitudes de la grille physique")
+283d204
+< 
+285d205
+< 
+292,293c212,213
+<       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
+<      .                        "Latitudes of physics grid")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
+>      .                        "Latitudes de la grille physique")
+300d219
+< 
+302d220
+< 
+309,310c227,228
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+<      .                        "Mesh area")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+>      .                        "Aire des mailles")
+317d234
+< 
+319d235
+< 
+326,327c242,243
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+<      .                        "Geopotential at the surface")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+>      .                        "Geopotentiel au sol")
+334d249
+< 
+336d250
+< 
+343,344c257,258
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 21,
+<      .                        "Albedo of bare ground")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+>      .                        "Albedo du sol nu")
+351d264
+< 
+353c266,279
+< c   some data for Francois Lott's programs
+---
+>       ierr = NF_REDEF (nid)
+> #ifdef NC_DOUBLE
+>       ierr = NF_DEF_VAR (nid, "inertiedat", NF_DOUBLE, 1, idim2,nvarid)
+> #else
+>       ierr = NF_DEF_VAR (nid, "inertiedat", NF_FLOAT, 1, idim2,nvarid)
+> #endif
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
+>      .                        "Inertie thermique du sol")
+>       ierr = NF_ENDDEF(nid)
+> #ifdef NC_DOUBLE
+>       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
+> #else
+>       ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
+> #endif
+354a281
+> c   fichier pour les programmes de Francois Lott
+362,363c289,290
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+<      .                        "Relief: mean relief")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+>      .                        "Relief moyen")
+377,378c304,305
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
+<      .                        "Relief: standard deviation")
+---
+>       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
+>      .                        "Ecartype du relief")
+393c320
+<      .                        "Relief: sigma parameter")
+---
+>      .                        "Relief: parametre sigma")
+408c335
+<      .                        "Relief: gamma parameter")
+---
+>      .                        "Relief: parametre gamma")
+423c350
+<      .                        "Relief: theta parameter")
+---
+>      .                        "Relief: parametre theta")
+431,434c358
+< c Write the physical fields
+< 
+< ! CO2 Ice Cover
+< 
+---
+> c Ecriture des champs physiques
+449,470c373
+< 
+< ! Soil Thermal inertia
+< 
+<       ierr = NF_REDEF (nid)
+< #ifdef NC_DOUBLE
+<       ierr = NF_DEF_VAR (nid,"inertiedat",NF_DOUBLE,
+<      &                   2,(/idim2,idim3/),nvarid)
+< #else
+<       ierr = NF_DEF_VAR (nid,"inertiedat",NF_FLOAT,
+<      &                   2,(/idim2,idim3/),nvarid)
+< #endif
+<       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 20,
+<      .                        "Soil thermal inertia")
+<       ierr = NF_ENDDEF(nid)
+< #ifdef NC_DOUBLE
+<       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
+< #else
+<       ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
+< #endif
+< 
+< !  Surface temperature
+< 
+---
+> c
+485,487c388
+< 
+< ! Soil temperature
+< 
+---
+> c
+492d392
+< !      ierr = NF_DEF_VAR (nid, "tsoil", NF_FLOAT, 2, idim2,nvarid)
+503,505c403
+< 
+< c emissivity
+< 
+---
+> c
+520,522c418
+< 
+< c planetary boundary layer
+< 
+---
+> c
+525c421,423
+<       ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
+---
+>       ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, 
+>      .  (/idim2,idim4/),nvarid)
+> c****WRF: ligne trop longue ....
+537,572c435
+<       IF (ierr.NE.NF_NOERR) THEN
+<         PRINT*, 'physdem1: Failed to write q2'
+<         CALL abort
+<       ENDIF
+< 
+< c tracers
+< 
+< ! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+< !                    qsurf02, ...)
+<       count=0
+<       do iq=1,nqmx
+<         txt= " "
+<         write(txt,'(a1,i2.2)')'q',iq
+<         if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
+<           ! did not find old tracer name
+<           exit ! might as well stop here
+<         else
+<           ! found old tracer name
+<           count=count+1
+<         endif
+<       enddo
+<       if (count.eq.nqmx) then
+<         write(*,*) "physdem1:tracers seem to follow old naming ",
+<      &             "convention (qsurf01,qsurf02,...)"
+<         write(*,*) "   => will work for now ... "
+<         write(*,*) "      but you should run newstart to rename them"
+<         oldtracernames=.true.
+<         ! Moreover, if computing water cycle with ice, move surface ice
+<         ! back to qsurf(nqmx)
+<         IF (water) THEN
+<           write(*,*)'physdem1: moving surface water ice to index ',nqmx
+<           qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1)
+<           qsurf(1:ngridmx,nqmx-1)=0
+<         ENDIF
+<       endif ! of if (count.eq.nqmx)
+< 
+---
+> c
+574,590d436
+< ! preliminary stuff: look for water vapour & water ice tracers (if any)
+<         if (.not.oldtracernames) then
+<          do iq=1,nq
+<            if (tnom(iq).eq."h2o_vap") then
+<              i_h2o_vap=iq
+<            endif
+<            if (tnom(iq).eq."h2o_ice") then
+<              i_h2o_ice=iq
+<            endif
+<          enddo ! of iq=1,nq
+<          ! handle special case of only water vapour tracer (no ice)
+<          if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
+<           ! then the index of (surface) ice is i_h2o_vap
+<           i_h2o_ice=i_h2o_vap
+<          endif
+<         endif ! of if (.not.oldtracernames) 
+< 
+592,652c438,456
+<            IF (oldtracernames) THEN
+<              txt=" "
+<              write(txt,'(a5,i2.2)')'qsurf',iq
+<            ELSE
+<              txt=tnom(iq)
+<              ! Exception: there is no water vapour surface tracer
+<              if (txt.eq."h2o_vap") then
+<                write(*,*)"physdem1: skipping water vapour tracer"
+<                if (i_h2o_ice.eq.i_h2o_vap) then
+<                ! then there is no "water ice" tracer; but still
+<                ! there is some water ice on the surface
+<                  write(*,*)"          writting water ice instead"
+<                  txt="h2o_ice"
+<                else
+<                ! there is a "water ice" tracer which has been / will be
+<                ! delt with in due time
+<                  cycle
+<                endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
+<              endif ! of if (txt.eq."h2o_vap")
+<            ENDIF ! of IF (oldtracernames)
+< 
+<            ierr=NF_REDEF(nid)
+<            IF (ierr.NE.NF_NOERR) THEN
+<              PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+<              CALL abort
+<            ENDIF
+< #ifdef NC_DOUBLE
+<            ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,1,idim2,nvarid)
+< #else
+<            ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,1,idim2,nvarid)
+< #endif
+<            IF (ierr.NE.NF_NOERR) THEN
+<              PRINT*, 'physdem1: Failed to define ',trim(txt)
+<              CALL abort
+<            ENDIF
+<            ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+<      &                        "tracer on surface")
+<            IF (ierr.NE.NF_NOERR) THEN
+<              PRINT*, 'physdem1: Failed to define ',trim(txt),
+<      &               ' title attribute'
+<              CALL abort
+<            ENDIF
+<            ierr=NF_ENDDEF(nid)
+<            IF (ierr.NE.NF_NOERR) THEN
+<              PRINT*, 'physdem1: Failed to swich out of define mode'
+<              CALL abort
+<            ENDIF
+<            
+< #ifdef NC_DOUBLE
+<             ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
+< #else
+<             ierr=NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
+< #endif
+<            IF (ierr.NE.NF_NOERR) THEN
+<              PRINT*, 'physdem1: Failed to write ',trim(txt)
+<              CALL abort
+<            ENDIF
+<          ENDDO ! of DO iq=1,nq
+<       ENDIF ! of IF(nq.GE.1)
+< 
+< c close file
+---
+>             str7(1:5)='qsurf'
+>             WRITE(str7(6:7),'(i2.2)') iq
+>             ierr = NF_REDEF (nid)
+> #ifdef NC_DOUBLE
+>             ierr = NF_DEF_VAR (nid,str7,NF_DOUBLE,1,idim2,nvarid)
+> #else
+>             ierr = NF_DEF_VAR (nid,str7,NF_FLOAT,1,idim2,nvarid)
+> #endif
+>             ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+>      .                        "tracer on surface")
+>             ierr = NF_ENDDEF(nid)
+> #ifdef NC_DOUBLE
+>             ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
+> #else
+>             ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
+> #endif
+>          ENDDO
+>       ENDIF
+> c
+1,4c1
+< !      SUBROUTINE profile(unit,nlev,zkm,temp)
+<       SUBROUTINE profile(nlev,zkm,temp)
+< ! to use  'getin'
+<       USE ioipsl_getincom 
+---
+>       SUBROUTINE profile(unit,nlev,zkm,temp)
+12a10
+> c     unit    unite de lecture de "testphys1d.def"
+41c39
+<        INTEGER nlev
+---
+>        INTEGER nlev, unit
+61,75c59,60
+< c   read input profile type:
+< c--------------------------
+< 
+<       ichoice=1 ! default value for ichoice
+<       call getin("ichoice",ichoice)
+<       tref=200 ! default value for tref
+<       call getin("tref",tref)
+<       isin=0 ! default value for isin (=0 means no perturbation)
+<       call getin("isin",isin)
+<       pic=26.522 ! default value for pic
+<       call getin("pic",pic)
+<       largeur=10 ! default value for largeur
+<       call getin("largeur",largeur)
+<       hauteur=30 ! default value for hauteur
+<       call getin("hauteur",hauteur)
+---
+> c   choix du profile:
+> c   -----------------
+76a62,74
+>       READ(unit,*) 
+>       READ(unit,*) 
+>       READ(unit,*) 
+>       READ(unit,*) ichoice
+>       READ(unit,*) tref
+>       READ(unit,*,ERR=200) isin
+>       READ(unit,*) pic
+>       READ(unit,*) largeur
+>       READ(unit,*) hauteur
+>       GOTO 200
+> 100   STOP'fichier profile.def inexistant'
+> 200   CONTINUE
+>       CLOSE(unit)
+7,12c7,11
+< #include "dimensions.h"
+< #include "dimphys.h"
+< #include "comgeomfi.h"
+< #include "netcdf.inc"
+< #include "datafile.h"
+< #include "callkeys.h"
+---
+> include "dimensions.h"
+> include "dimphys.h"
+> include "comgeomfi.h"
+> include "netcdf.inc"
+> include "datafile.h"
+34c33
+< real,save :: radeg,pi
+---
+> real radeg,pi
+39c38
+< character(len=33) :: filename
+---
+> INTEGER, external:: lnblnk
+40a40,41
+> pi=acos(-1.)
+> radeg=180/pi
+46,63d46
+<    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"
+<    endif
+<    
+65c48
+<    ierr=NF_OPEN(trim(datafile)//"/"//trim(filename),NF_NOWRITE,nid)
+---
+>    ierr=NF_OPEN (datafile(1:lnblnk(datafile))//"/dust_tes.nc",NF_NOWRITE,nid)
+67,68c50,51
+<      write(*,*)'Problem opening ',trim(filename),' (in phymars/readtesassim.F90)'
+<      write(*,*)'It should be in :',trim(datafile),'/'
+---
+>      write(*,*)'Problem opening dust.nc (in phymars/readtesassim.F90)'
+>      write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+277,288c260,261
+< ! 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.35
+<      else
+<        write(*,*) "readtesassim: wrong value for flag swrtype !"
+<        stop
+<      endif
+<    endif ! of if (swrtype.eq.1)
+---
+> !   tauref(ig)=tau*700/pplev(ig,1)*0.8
+>     tauref(ig)=tau*0.825
+1,14c1,46
+<       subroutine soil(ngrid,nsoil,firstcall,
+<      &          therm_i,
+<      &          timestep,tsurf,tsoil,
+<      &          capcal,fluxgrd)
+<       implicit none
+< 
+< !-----------------------------------------------------------------------
+< !  Author: Ehouarn Millour
+< !
+< !  Purpose: Compute soil temperature using an implict 1st order scheme
+< !  
+< !  Note: depths of layers and mid-layers, soil thermal inertia and 
+< !        heat capacity are commons in comsoil.h
+< !-----------------------------------------------------------------------
+---
+>       SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i,
+>      s          ptimestep,ptsrf,ptsoil,
+>      s          pcapcal,pfluxgrd)
+>       IMPLICIT NONE
+> 
+> c=======================================================================
+> c
+> c   Auteur:  Frederic Hourdin     30/01/92
+> c   -------
+> c
+> c   objet:  computation of : the soil temperature evolution
+> c   ------                   the surfacic heat capacity "Capcal"
+> c                            the surface conduction flux pcapcal
+> c
+> c
+> c   Method: implicit time integration
+> c   -------
+> c   Consecutive ground temperatures are related by:
+> c           T(k+1) = C(k) + D(k)*T(k)  (1)
+> c   the coefficients C and D are computed at the t-dt time-step.
+> c   Routine structure:
+> c   1)new temperatures are computed  using (1)
+> c   2)C and D coefficients are computed from the new temperature
+> c     profile for the t+dt time-step
+> c   3)the coefficients A and B are computed where the diffusive
+> c     fluxes at the t+dt time-step is given by
+> c            Fdiff = A + B Ts(t+dt)
+> c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
+> c            with F0 = A + B (Ts(t))
+> c                 Capcal = B*dt
+> c           
+> c   Interface:
+> c   ----------
+> c
+> c   Arguments:
+> c   ----------
+> c   ngird               number of grid-points
+> c   ptimestep              physical timestep (s)
+> c   pto(ngrid,nsoil)     temperature at time-step t (K)
+> c   ptn(ngrid,nsoil)     temperature at time step t+dt (K)
+> c   pcapcal(ngrid)      specific heat (W*m-2*s*K-1)
+> c   pfluxgrd(ngrid)      surface diffusive flux from ground (Wm-2)
+> c   
+> c=======================================================================
+> c   declarations:
+> c   -------------
+19c51,82
+< #include"comsoil.h"
+---
+> c-----------------------------------------------------------------------
+> c  arguments
+> c  ---------
+> 
+>       INTEGER ngrid,nsoil
+>       REAL ptimestep
+>       REAL ptsrf(ngridmx),ptsoil(ngrid,nsoilmx),ptherm_i(ngridmx)
+>       REAL pcapcal(ngrid),pfluxgrd(ngrid)
+>       LOGICAL firstcall
+> 
+> c-----------------------------------------------------------------------
+> c  local arrays
+> c  ------------
+> 
+>       INTEGER ig,jk
+>       REAL za(ngridmx),zb(ngridmx)
+>       REAL zdz2(nsoilmx),z1(ngridmx)
+>       REAL min_period,dalph_soil
+> 
+> c   local saved variables:
+> c   ----------------------
+>       REAL dz1(nsoilmx),dz2(nsoilmx)
+>       REAL zc(ngridmx,nsoilmx),zd(ngridmx,nsoilmx)
+>       REAL lambda
+>       SAVE dz1,dz2,zc,zd,lambda
+> 
+> c-----------------------------------------------------------------------
+> c   Depthts:
+> c   --------
+> 
+>       REAL fz,rk,fz1,rk1,rk2
+>       fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
+20a84,131
+>       IF (firstcall) THEN
+> 
+> c-----------------------------------------------------------------------
+> c   ground levels 
+> c   grnd=z/l where l is the skin depth of the diurnal cycle:
+> c   --------------------------------------------------------
+> 
+>          min_period=887.75
+> c        min_period=1800.
+> c        min_period=20000.
+>          dalph_soil=2.
+> 
+>          OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
+>          READ(99,*) min_period
+>          READ(99,*) dalph_soil
+>          PRINT*,'Discretization for the soil model'
+>          PRINT*,'First level e-folding depth',min_period,
+>      s   '   dalph',dalph_soil
+>          CLOSE(99)
+> 9999     CONTINUE
+> 
+> c   la premiere couche represente un dixieme de cycle diurne
+>          fz1=sqrt(min_period/3.14)
+> 
+>          DO jk=1,nsoil
+>             rk1=jk
+>             rk2=jk-1
+>             dz2(jk)=fz(rk1)-fz(rk2)
+>          ENDDO
+>          DO jk=1,nsoil-1
+>             rk1=jk+.5
+>             rk2=jk-.5
+>             dz1(jk)=1./(fz(rk1)-fz(rk2))
+>          ENDDO
+>          lambda=fz(.5)*dz1(1)
+>          PRINT*,'full layers, intermediate layers (secoonds)'
+>          DO jk=1,nsoil
+>             rk=jk
+>             rk1=jk+.5
+>             rk2=jk-.5
+>             PRINT*,fz(rk1)*fz(rk2)*3.14,
+>      s      fz(rk)*fz(rk)*3.14
+>          ENDDO
+> 
+> c   Initialisations:
+> c   ----------------
+> 
+>       ELSE
+22,163c133,148
+< !  arguments
+< !  ---------
+< !  inputs:
+<       integer ngrid	! number of (horizontal) grid-points 
+<       integer nsoil	! number of soil layers 
+<       logical firstcall ! identifier for initialization call 
+<       real therm_i(ngrid,nsoil) ! thermal inertia
+<       real timestep	    ! time step
+<       real tsurf(ngrid)   ! surface temperature
+< ! outputs:
+<       real tsoil(ngrid,nsoil) ! soil (mid-layer) temperature
+<       real capcal(ngrid) ! surface specific heat
+<       real fluxgrd(ngrid) ! surface diffusive heat flux
+< 
+< ! local saved variables:
+< !      real,save :: layer(ngridmx,nsoilmx)	! layer depth
+<       real,save :: mthermdiff(ngridmx,0:nsoilmx-1) ! mid-layer thermal diffusivity
+<       real,save :: thermdiff(ngridmx,nsoilmx-1) ! inter-layer thermal diffusivity
+<       real,save :: coefq(0:nsoilmx-1)		! q_{k+1/2} coefficients
+<       real,save :: coefd(ngridmx,nsoilmx-1)	! d_k coefficients
+<       real,save :: alph(ngridmx,nsoilmx-1)	! alpha_k coefficients
+<       real,save :: beta(ngridmx,nsoilmx-1)	! beta_k coefficients
+<       real,save :: mu
+<       
+< ! local variables:
+<       integer ig,ik
+< 
+< ! 0. Initialisations and preprocessing step
+<       if (firstcall) then
+<       ! note: firstcall is set to .true. or .false. by the caller
+<       !       and not changed by soil.F 
+< ! 0.1 Build mthermdiff(:), the mid-layer thermal diffusivities
+<       do ig=1,ngrid
+<         do ik=0,nsoil-1
+< 	  mthermdiff(ig,ik)=therm_i(ig,ik+1)*therm_i(ig,ik+1)/volcapa
+< !	  write(*,*),'soil: ik: ',ik,' mthermdiff:',mthermdiff(ig,ik)
+< 	enddo
+<       enddo
+< 
+< ! 0.2 Build thermdiff(:), the "interlayer" thermal diffusivities
+<       do ig=1,ngrid
+<         do ik=1,nsoil-1
+<       thermdiff(ig,ik)=((layer(ik)-mlayer(ik-1))*mthermdiff(ig,ik)
+<      &                +(mlayer(ik)-layer(ik))*mthermdiff(ig,ik-1))
+<      &                    /(mlayer(ik)-mlayer(ik-1))
+< !	write(*,*),'soil: ik: ',ik,' thermdiff:',thermdiff(ig,ik)
+< 	enddo
+<       enddo
+< 
+< ! 0.3 Build coefficients mu, q_{k+1/2}, d_k, alpha_k and capcal
+<       ! mu
+<       mu=mlayer(0)/(mlayer(1)-mlayer(0))
+< 
+<       ! q_{1/2}
+<       coefq(0)=volcapa*layer(1)/timestep
+< 	! q_{k+1/2}
+<         do ik=1,nsoil-1
+<           coefq(ik)=volcapa*(layer(ik+1)-layer(ik))
+<      &                 /timestep
+< 	enddo
+< 
+<       do ig=1,ngrid
+< 	! d_k
+< 	do ik=1,nsoil-1
+< 	  coefd(ig,ik)=thermdiff(ig,ik)/(mlayer(ik)-mlayer(ik-1))
+< 	enddo
+< 	
+< 	! alph_{N-1}
+< 	alph(ig,nsoil-1)=coefd(ig,nsoil-1)/
+<      &                  (coefq(nsoil-1)+coefd(ig,nsoil-1))
+<         ! alph_k
+<         do ik=nsoil-2,1,-1
+< 	  alph(ig,ik)=coefd(ig,ik)/(coefq(ik)+coefd(ig,ik+1)*
+<      &                              (1.-alph(ig,ik+1))+coefd(ig,ik))
+< 	enddo
+< 
+<         ! capcal
+< ! Cstar
+<         capcal(ig)=volcapa*layer(1)+
+<      &              (thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+<      &              (timestep*(1.-alph(ig,1)))
+< ! Cs
+<         capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+<      &                         thermdiff(ig,1)/mthermdiff(ig,0))
+< !      write(*,*)'soil: ig=',ig,' capcal(ig)=',capcal(ig)
+<       enddo ! of do ig=1,ngrid
+<             
+<       else ! of if (firstcall)
+< 
+< !  1. Compute soil temperatures
+< ! First layer:
+<       do ig=1,ngrid
+<         tsoil(ig,1)=(tsurf(ig)+mu*beta(ig,1)*
+<      &                         thermdiff(ig,1)/mthermdiff(ig,0))/
+<      &              (1.+mu*(1.0-alph(ig,1))*
+<      &               thermdiff(ig,1)/mthermdiff(ig,0))
+<       enddo
+< ! Other layers:
+<       do ik=1,nsoil-1
+<         do ig=1,ngrid
+< 	  tsoil(ig,ik+1)=alph(ig,ik)*tsoil(ig,ik)+beta(ig,ik)
+< 	enddo
+<       enddo
+<       
+<       endif! of if (firstcall)
+< 
+< !  2. Compute beta coefficients (preprocessing for next time step)
+< ! Bottom layer, beta_{N-1}
+<       do ig=1,ngrid
+<         beta(ig,nsoil-1)=coefq(nsoil-1)*tsoil(ig,nsoil)
+<      &                   /(coefq(nsoil-1)+coefd(ig,nsoil-1))
+<       enddo
+< ! Other layers
+<       do ik=nsoil-2,1,-1
+<         do ig=1,ngrid
+< 	  beta(ig,ik)=(coefq(ik)*tsoil(ig,ik+1)+
+<      &                 coefd(ig,ik+1)*beta(ig,ik+1))/
+<      &                 (coefq(ik)+coefd(ig,ik+1)*(1.0-alph(ig,ik+1))
+<      &                  +coefd(ig,ik))
+< 	enddo
+<       enddo
+< 
+< !  3. Compute surface diffusive flux & calorific capacity
+<       do ig=1,ngrid
+< ! Cstar
+< !        capcal(ig)=volcapa(ig,1)*layer(ig,1)+
+< !     &              (thermdiff(ig,1)/(mlayer(ig,1)-mlayer(ig,0)))*
+< !     &              (timestep*(1.-alph(ig,1)))
+< ! Fstar
+<         fluxgrd(ig)=(thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+<      &              (beta(ig,1)+(alph(ig,1)-1.0)*tsoil(ig,1))
+< 
+< !        mu=mlayer(ig,0)/(mlayer(ig,1)-mlayer(ig,0))
+< !        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+< !     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+< ! Fs
+<         fluxgrd(ig)=fluxgrd(ig)+(capcal(ig)/timestep)*
+<      &              (tsoil(ig,1)*(1.+mu*(1.0-alph(ig,1))*
+<      &                         thermdiff(ig,1)/mthermdiff(ig,0))
+<      &               -tsurf(ig)-mu*beta(ig,1)*
+<      &                          thermdiff(ig,1)/mthermdiff(ig,0))
+<       enddo
+---
+> c   Computation of the soil temperatures using the Cgrd and Dgrd
+> c  coefficient computed at the previous time-step:
+> c  -----------------------------------------------
+> 
+> c    surface temperature
+>          DO ig=1,ngrid
+>             ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
+>      s      (lambda*(1.-zd(ig,1))+1.)
+>          ENDDO
+> 
+> c   other temperatures
+>          DO jk=1,nsoil-1
+>             DO ig=1,ngrid
+>                ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
+>             ENDDO
+>          ENDDO
+165c150,189
+<       end
+---
+>       ENDIF
+> c-----------------------------------------------------------------------
+> c   Computation of the Cgrd and Dgrd coefficient for the next step:
+> c   ---------------------------------------------------------------
+> 
+>       DO jk=1,nsoil
+>          zdz2(jk)=dz2(jk)/ptimestep
+>       ENDDO
+> 
+>       DO ig=1,ngrid
+>          z1(ig)=zdz2(nsoil)+dz1(nsoil-1)
+>          zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig)
+>          zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig)
+>       ENDDO
+> 
+>       DO jk=nsoil-1,2,-1
+>          DO ig=1,ngrid
+>             z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
+>             zc(ig,jk-1)=
+>      s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
+>             zd(ig,jk-1)=dz1(jk-1)*z1(ig)
+>          ENDDO
+>       ENDDO
+> 
+> c-----------------------------------------------------------------------
+> c   computation of the surface diffusive flux from ground and
+> c   calorific capacity of the ground:
+> c   ---------------------------------
+> 
+>       DO ig=1,ngrid
+>          pfluxgrd(ig)=ptherm_i(ig)*dz1(1)*
+>      s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
+>          pcapcal(ig)=ptherm_i(ig)*
+>      s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
+>          z1(ig)=lambda*(1.-zd(ig,1))+1.
+>          pcapcal(ig)=pcapcal(ig)/z1(ig)
+>          pfluxgrd(ig)=pfluxgrd(ig)
+>      s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
+>      s   /ptimestep
+>       ENDDO
+166a191,192
+>       RETURN
+>       END
+65a66
+> 	 print*,'call>iniorbit'
+95a97,98
+> 
+> 	PRINT*,'aerocentric longitude (deg) :',psollong*180./pi
+99c102
+< 
+---
+> c
+1,5c1,5
+<       COMMON/surfdat/albedodat(ngridmx),                                &
+<      &   phisfi(ngridmx),albedice(2),emisice(2),emissiv,                &
+<      &   iceradius(2) , dtemisice(2),                                   &
+<      &   zmea(ngridmx),zstd(ngridmx),                                   &
+<      &   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+---
+>       COMMON/surfdat/albedodat(ngridmx),inertiedat(ngridmx),
+>      s   phisfi(ngridmx),albedice(2),emisice(2),emissiv,
+>      s   iceradius(2) , dtemisice(2),
+>      s   zmea(ngridmx),zstd(ngridmx),
+>      s   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+7,14c7,8
+<       real albedodat ! albedo of bare ground
+< ! Ehouarn: moved inertiedat to comsoil.h
+< !      real inertiedat, ! thermal inertia
+<       real phisfi ! geopotential at ground level
+<       real albedice
+<       real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+<       real emissiv
+<       real iceradius , dtemisice
+---
+>       REAL albedodat,inertiedat,phisfi,albedice,emisice,emissiv,
+>      s   iceradius , dtemisice
+4,5c4
+<      $                PHEAT, PFLUXD,PFLUXU,
+<      &                QVISsQREF3d,omegaVIS3d,gVIS3d)
+---
+>      $                PHEAT, PFLUXD,PFLUXU)
+48,49d46
+< c    QVISsQREF3d,omegaVIS3d,gVIS3d Aerosol optical properties
+< c
+75,77d71
+<       REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+<       REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+<       REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+139a134,136
+>          CALL SWR ( KDLON, kflev, INU
+>      S     ,  aerosol,albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+>      S     ,  ZFD,ZFU )
+141,158d137
+< ! NB: swrtype is set in callkeys.h
+<         if (swrtype.eq.1) then ! Fouquart
+<           CALL SWR_FOUQUART( KDLON, kflev, INU
+<      &     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+<      &     ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+<      &     ,  ZFD,ZFU )
+<         else
+<           if (swrtype.eq.2) then ! Toon
+<             CALL SWR_TOON( KDLON, kflev, INU
+<      &       ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+<      &       ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+<      &       ,  ZFD,ZFU )
+<           else
+<             write(*,*) "swmain: invalid swrtype value !!"
+<             stop
+<           endif ! of if (swrtype.eq.2)
+<         endif ! of if (swrtype.eq.1)
+<         
+165c144
+<       END DO ! of DO INU=1,2
+---
+>       END DO
+184a164,168
+> c TEST pour diminuer erreur eddington pour diffuseurs simples	    
+> c           if (activice) then   
+> c	    if(aerosol(JL,JK,2)/aerosol(JL,JK,1).gt.1) 
+> c     s 	    PHEAT(JL,JK) =PHEAT(JL,JK)/10.
+> c           endif 
+54d53
+< #include "comsoil.h"
+75c74
+<       REAL tab_cntrl(length) ! array in which are stored the run's parameters
+---
+>       REAL tab_cntrl(length) ! tableau des parametres du run
+87c86
+< c  Initialization of various physical constants to defaut values (nid = 0 case)
+---
+> c  Initialisation des constantes physiques par defaut (cas nid = 0)
+91c90
+< c Reference pressure
+---
+> c Pression de reference sur la planete
+95c94
+< c Infos about Mars for the dynamics and physics
+---
+> c Info sur la Planete Mars pour la dynamique et la physique
+97,101c96,100
+<       rad=3397200.          ! radius of Mars (m)  ~3397200 m
+<       daysec=88775.         ! length of a sol (s)  ~88775 s
+<       omeg=4.*asin(1.)/(daysec)       ! rotation rate  (rad.s-1)
+<       g=3.72                ! gravity (m.s-2) ~3.72
+<       mugaz=43.49           ! Molar mass of the atmosphere (g.mol-1) ~43.49
+---
+>       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
+104c103
+< c Informations about Mars, only for physics
+---
+> c Info sur la Planete Mars pour la physique uniquement
+106,110c105,109
+<       year_day = 669.       !Modif FH: length of year (sols) ~668.6
+<       periheli = 206.66         ! min. Sun-Mars distance (Mkm) ~206.66
+<       aphelie = 249.22          ! max. Sun-Mars distance (Mkm) ~249.22
+<       peri_day =  485.    ! date of perihelion (sols since N. spring)
+<       obliquit = 25.19         ! Obliquity of the planet (deg) ~25.19
+---
+>       year_day = 669.       !modif FH  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.19         ! Obliquite de la planete (deg) ~25.19
+112c111
+< c Boundary layer and turbulence
+---
+> c Couche limite et Turbulence
+115,116c114,115
+<       emin_turb = 1.e-6         ! minimal energy ~1.e-8
+<       lmixmin = 30              ! mixing length ~100
+---
+>       emin_turb = 1.e-6         ! energie minimale ~1.e-8
+>       lmixmin = 30              ! longueur de melange ~100
+118c117
+< c Optical properties of polar caps and ground emissivity
+---
+> c propriete optiques des calottes et emissivite du sol
+120,124c119,123
+<       emissiv=.95               ! Emissivity of martian soil ~.95
+<       emisice(1)=0.95           ! Emissivity of northern cap
+<       emisice(2)=0.95           ! Emissivity of southern cap
+<       albedice(1)=0.65          ! Albedo of northern cap
+<       albedice(2)=0.65          ! Albedo of southern cap
+---
+>       emissiv=.95               ! Emissivite du sol martien ~.95
+>       emisice(1)=0.95           ! Emissivite calotte nord
+>       emisice(2)=0.95           ! Emissivite calotte sud
+>       albedice(1)=0.65          ! Albedo calotte nord
+>       albedice(2)=0.65          ! Albedo calotte sud
+130c129
+< c dust aerosol properties
+---
+> c Proprietes des poussiere aerosol
+132c131
+<       tauvis= 0.2          ! mean visible optical depth
+---
+>       tauvis= 0.2          ! profondeur optique visible moyenne
+140,143c139
+< 
+< c soil properties
+<       volcapa = 1.e6 ! soil volumetric heat capacity (in comsoil.h)
+<       ELSE
+---
+>  
+145,146c141,142
+< c  Initialization of physical constants by reading array tab_cntrl(:)
+< c		which contains these parameters	(nid != 0 case)
+---
+> c  Initialisation des constantes physiques par lecture du tableau 
+> c		des parametres du run (tab_cntrl) 	(cas nid != 0)
+148c144,146
+< c Read 'controle' array
+---
+>       ELSE
+> 
+> c Lecture du tableau
+152c150
+<          PRINT*, "Tabfi: Could not find <controle> data"
+---
+>          PRINT*, "Tabfi: Le champ <controle> est absent"
+161c159
+<          PRINT*, "Tabfi: Failed reading <controle> array"
+---
+>          PRINT*, "Tabfi: Lecture echoue pour <controle>"
+165c163
+<        print*,'tabfi: tab_cntrl',tab_cntrl
+---
+>        print*,'tab_cntrl',tab_cntrl
+167,168c165,166
+< c  Initialization of some physical constants
+< c informations on physics grid
+---
+> c  Initialisation des constantes physiques
+> c infor sur la grille physique
+170c168
+<          print*,'tabfi: WARNING !!! tab_cntrl(tab0+1).ne.ngridmx'
+---
+>          print*,'WARNING !!! tab_cntrl(tab0+1).ne.ngridmx'
+177c175
+< c Informations about planet Mars for dynamics and physics
+---
+> c Info sur la Planete Mars pour la dynamique et la physique
+185c183
+< c Informations about planet Mars for the physics only
+---
+> c Info sur la Planete Mars pour la physique uniquement
+191c189
+< c boundary layer and turbeulence
+---
+> c couche limite et turbeulence
+195c193
+< c optical properties of polar caps and ground emissivity
+---
+> c proprietes optiques des calottes et emissivite du sol
+206,207d203
+< c soil properties
+<       volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity
+209c205
+< c	Save some constants for later use (as routine arguments)
+---
+> c	Sauvegarde des constantes pour passages en arguments
+217c213
+<       ENDIF    ! end of (nid = 0) 
+---
+>       ENDIF    ! (du if nid = 0) 
+220c216
+< c	Write physical constants to output before modifying them
+---
+> c	Impression des constantes physiques avant modif
+227c223
+<       write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+---
+>       write(*,*) 'lecture du tab_cntrl a l appel de tabfi avant modif'
+262,263d257
+<       write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+< 
+265c259
+<       write(*,*) 'Lmodif in tabfi!!!!!!!',Lmodif
+---
+>       write(*,*) 'Lmodif dans tabfi!!!!!!!',Lmodif
+274,276c268,270
+<       write(*,*) 'Change values in tab_cntrl ? :'
+<       write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+<       write(*,*) '(Current values given above)'
+---
+>       write(*,*) 'Modifications des valeurs du tab_cntrl:'
+>       write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+>       write(*,*) '(valeurs actuelles indiquees ci-dessus)'
+278c272
+<       write(*,*) '(3)          day_ini : Initial day (=0 at Ls=0)'
+---
+>       write(*,*) '(3)          day_ini : Jour initial (=0 a Ls=0)'
+280,284c274,278
+<       write(*,*) '(21)       emin_turb :  minimal energy (PBL)'
+<       write(*,*) '(20)         lmixmin : mixing length (PBL)'
+<       write(*,*) '(26)         emissiv : ground emissivity'
+<       write(*,*) '(24 et 25)   emisice : CO2 ice max emissivity '
+<       write(*,*) '(22 et 23)  albedice : CO2 ice cap albedos'
+---
+>       write(*,*) '(21)       emin_turb :  energie minimale'
+>       write(*,*) '(20)         lmixmin : longueur de melange'
+>       write(*,*) '(26)         emissiv : Emissivite du sol martien'
+>       write(*,*) '(24 et 25)   emisice : Emissivite des calottes '
+>       write(*,*) '(22 et 23)  albedice : Albedo des calotte'
+287,290c281,283
+<      &           ' metamorphism'
+<       write(*,*) '(27)        tauvis : mean dust vis. reference ',
+<      &           'opacity'
+<       write(*,*) '(35)         volcapa : soil volumetric heat capacity'
+---
+>      . ' metamorphism'
+>       write(*,*) '(27)          tauvis : profondeur optique visible',
+>      . ' moyenne'
+301,302c294,295
+<         write(*,*) 'Changes to perform ?'
+<         write(*,*) '   (enter keyword or return )'
+---
+>         write(*,*) 'modification a faire ?'
+>         write(*,*) '   (entrer le mot cle ou return pour finir)'
+311,312c304,305
+<           write(*,*) 'current value:',day_ini
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',day_ini
+>           write(*,*) 'entrer la nouvelle valeur:'
+316c309
+<           write(*,*) 'day_ini (new value):',day_ini
+---
+>           write(*,*) 'day_ini (nouvelle valeur):',day_ini
+319,320c312,313
+<           write(*,*) 'current value:',z0
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',z0
+>           write(*,*) 'entrer la nouvelle valeur:'
+324c317
+<           write(*,*) ' z0 (new value):',z0
+---
+>           write(*,*) ' z0 (nouvelle valeur):',z0
+327,328c320,321
+<           write(*,*) 'current value:',emin_turb
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',emin_turb
+>           write(*,*) 'entrer la nouvelle valeur:'
+332c325
+<           write(*,*) ' emin_turb (new value):',emin_turb
+---
+>           write(*,*) ' emin_turb (nouvelle valeur):',emin_turb
+335,336c328,329
+<           write(*,*) 'current value:',lmixmin
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',lmixmin
+>           write(*,*) 'entrer la nouvelle valeur:'
+340c333
+<           write(*,*) ' lmixmin (new value):',lmixmin
+---
+>           write(*,*) ' lmixmin (nouvelle valeur):',lmixmin
+343,344c336,337
+<           write(*,*) 'current value:',emissiv
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',emissiv
+>           write(*,*) 'entrer la nouvelle valeur:'
+348c341
+<           write(*,*) ' emissiv (new value):',emissiv
+---
+>           write(*,*) ' emissiv (nouvelle valeur):',emissiv
+351,352c344,345
+<           write(*,*) 'current value emisice(1) North:',emisice(1)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle emisice(1) Nord:',emisice(1)
+>           write(*,*) 'entrer la nouvelle valeur:'
+356c349
+<           write(*,*) ' emisice(1) (new value):',emisice(1)
+---
+>           write(*,*) ' emisice(1) (nouvelle valeur):',emisice(1)
+359,360c352,353
+<           write(*,*) 'current value emisice(2) South:',emisice(2)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle emisice(2) Sud:',emisice(2)
+>           write(*,*) 'entrer la nouvelle valeur:'
+364c357
+<           write(*,*) ' emisice(2) (new value):',emisice(2)
+---
+>           write(*,*) ' emisice(2) (nouvelle valeur):',emisice(2)
+367,368c360,361
+<           write(*,*) 'current value albedice(1) North:',albedice(1)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle albedice(1) Nord:',albedice(1)
+>           write(*,*) 'entrer la nouvelle valeur:'
+372c365
+<           write(*,*) ' albedice(1) (new value):',albedice(1)
+---
+>           write(*,*) ' albedice(1) (nouvelle valeur):',albedice(1)
+375,376c368,369
+<           write(*,*) 'current value albedice(2) South:',albedice(2)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle albedice(2) Sud:',albedice(2)
+>           write(*,*) 'entrer la nouvelle valeur:'
+380c373
+<           write(*,*) ' albedice(2) (new value):',albedice(2)
+---
+>           write(*,*) ' albedice(2) (nouvelle valeur):',albedice(2)
+383,384c376,377
+<           write(*,*) 'current value iceradius(1) North:',iceradius(1)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle iceradius(1) Nord:',iceradius(1)
+>           write(*,*) 'entrer la nouvelle valeur:'
+388c381
+<           write(*,*) ' iceradius(1) (new value):',iceradius(1)
+---
+>           write(*,*) ' iceradius(1) (nouvelle valeur):',iceradius(1)
+391,392c384,385
+<           write(*,*) 'current value iceradius(2) South:',iceradius(2)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle iceradius(2) Sud:',iceradius(2)
+>           write(*,*) 'entrer la nouvelle valeur:'
+396c389
+<           write(*,*) ' iceradius(2) (new value):',iceradius(2)
+---
+>           write(*,*) ' iceradius(2) (nouvelle valeur):',iceradius(2)
+399,400c392,393
+<           write(*,*) 'current value dtemisice(1) North:',dtemisice(1)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle dtemisice(1) Nord:',dtemisice(1)
+>           write(*,*) 'entrer la nouvelle valeur:'
+404c397
+<           write(*,*) ' dtemisice(1) (new value):',dtemisice(1)
+---
+>           write(*,*) ' dtemisice(1) (nouvelle valeur):',dtemisice(1)
+407,408c400,401
+<           write(*,*) 'current value dtemisice(2) South:',dtemisice(2)
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle dtemisice(2) Sud:',dtemisice(2)
+>           write(*,*) 'entrer la nouvelle valeur:'
+412c405
+<           write(*,*) ' dtemisice(2) (new value):',dtemisice(2)
+---
+>           write(*,*) ' dtemisice(2) (nouvelle valeur):',dtemisice(2)
+415,416c408,409
+<           write(*,*) 'current value:',tauvis
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',tauvis
+>           write(*,*) 'entrer la nouvelle valeur:'
+420,421c413
+<           write(*,*) ' tauvis (new value):',tauvis
+< 
+---
+>           write(*,*) ' tauvis (nouvelle valeur):',tauvis
+423c415
+<           write(*,*) 'current value:',obliquit
+---
+>           write(*,*) 'valeur actuelle:',obliquit
+425c417
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'entrer la nouvelle valeur:'
+429c421
+<           write(*,*) ' obliquit (new value):',obliquit
+---
+>           write(*,*) ' obliquit (nouvelle valeur):',obliquit
+432c424
+<           write(*,*) 'current value:',peri_day
+---
+>           write(*,*) 'valeur actuelle:',peri_day
+434c426
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'entrer la nouvelle valeur:'
+438c430
+<           write(*,*) ' peri_day (new value):',peri_day
+---
+>           write(*,*) ' peri_day (nouvelle valeur):',peri_day
+441,443c433,435
+<           write(*,*) 'current value:',periheli
+<           write(*,*) 'perihelion should be 206.66 on current Mars'
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',periheli
+>           write(*,*) 'periheli should be 206.66 on current Mars'
+>           write(*,*) 'entrer la nouvelle valeur:'
+447c439
+<           write(*,*) ' periheli (new value):',periheli
+---
+>           write(*,*) ' periheli (nouvelle valeur):',periheli
+450,452c442,444
+<           write(*,*) 'current value:',aphelie
+<           write(*,*) 'aphelion should be 249.22 on current Mars'
+<           write(*,*) 'enter new value:'
+---
+>           write(*,*) 'valeur actuelle:',aphelie
+>           write(*,*) 'aphelie should be 249.22 on current Mars'
+>           write(*,*) 'entrer la nouvelle valeur:'
+456,464c448
+<           write(*,*) ' aphelie (new value):',aphelie
+<  
+<         else if (modif(1:lnblnk(modif)) .eq. 'volcapa') then
+<           write(*,*) 'current value:',volcapa
+<           write(*,*) 'enter new value:'
+<  119      read(*,*,iostat=ierr) volcapa
+<           if(ierr.ne.0) goto 119
+<           write(*,*) 
+<           write(*,*) ' volcapa (new value):',volcapa
+---
+>           write(*,*) ' aphelie (nouvelle valeur):',aphelie
+467c451
+<       enddo ! of do while(modif(1:1).ne.'hello')
+---
+>       enddo
+472c456
+< c	Write values of physical constants after modifications
+---
+> c	Impression des constantes physiques apres modif si modif
+476c460
+<       write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+---
+>       write(*,*) 'lecture du tab_cntrl a l appel de tabfi apres modif'
+511,512d494
+<       write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+< 
+516c498
+<       ENDIF 			!	of if (Lmodif == 1)
+---
+>       ENDIF 			!	(du if Lmodif = 1)
+526c508
+<          write (*,*) ' tabfi: WARNING : old initialisation file'
+---
+>          write (*,*) ' WARNING : old initialisation file'
+1,2c1,2
+< !-----------------------------------------------------------------------
+< ! INCLUDE 'tracer.h'
+---
+> c-----------------------------------------------------------------------
+> c INCLUDE 'tracer.h'
+4c4
+<       character*20  noms(nqmx)  ! name of the tracer
+---
+>       character*10  noms(nqmx)  ! name of the tracer
+7d6
+<       real rho_q(nqmx)    ! tracer densities (kg.m-3)
+21,52c20
+< ! tracer indexes: these are initialized in initracer and should be 0 if the
+< !                 corresponding tracer does not exist
+<       ! dust
+<       integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+<       ! dust, special doubleq case
+<       integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+<       integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+<       ! water
+<       integer :: igcm_h2o_vap ! water vapour
+<       integer :: igcm_h2o_ice ! water ice
+<       ! chemistry:
+<       integer :: igcm_co2
+<       integer :: igcm_co
+<       integer :: igcm_o
+<       integer :: igcm_o1d
+<       integer :: igcm_o2
+<       integer :: igcm_o3
+<       integer :: igcm_h
+<       integer :: igcm_h2
+<       integer :: igcm_oh
+<       integer :: igcm_ho2
+<       integer :: igcm_h2o2
+<       integer :: igcm_n2
+<       integer :: igcm_ar
+<       
+<       ! other tracers
+<       integer :: igcm_ar_n2 ! for simulations using co2 +neutral gas
+< 
+< 
+< ! NB: to keep commons aligned: 
+< !     split them in groups (reals, integers and characters)
+<       COMMON/tracer/radius,rho_q,qext,alpha_lift,alpha_devil,mmol,      &
+---
+>       COMMON/tracer/radius,qext,alpha_lift,alpha_devil,noms,mmol,
+54,60c22
+<       COMMON/tracer2/
+<      & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &
+<      & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+<      & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+<      & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+<       COMMON/tracer3/noms
+< !-----------------------------------------------------------------------
+---
+> c-----------------------------------------------------------------------
+1c1,3
+<       SUBROUTINE vdif_cd( ngrid,nlay,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+---
+>       SUBROUTINE vdif_cd( ngrid,nlay,pz0, 
+>      &    pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+> c****WRF:ligne trop longue
+70c70
+<       INTEGER ilev,ig,ilay,nlev
+---
+>       INTEGER ilev,ig,ilay,nlev,ierr
+74,75c74,75
+<       REAL zcdv(ngridmx),zcdh(ngridmx)
+<       REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+---
+> 	  REAL zcdv(ngridmx),zcdh(ngridmx)
+> 	  REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+93,94c93,94
+<       REAL hh , zhcond(ngridmx,nlayermx)
+<       REAL latcond,tcond1mb
+---
+>       REAL hh , zhcond(ngridmx,nlayermx), tconds
+>        REAL latcond,tcond1mb
+113c113
+<             PRINT*,'STOP dans vdifc'
+---
+>             PRINT*,'STOP dans coefdifv'
+123c123
+<          PRINT*,'          acond,bcond',acond,bcond
+---
+>          PRINT*,'acond,bcond,ccond',acond,bcond,acond
+125c125
+<         firstcall=.false.
+---
+>          firstcall=.false.
+161a162,163
+> 
+> 
+192c194,198
+<         call zerophys(ngrid*nlay,zhcond)
+---
+> c       DO ilev=1,nlay
+> c         DO ig=1,ngrid
+> c           zhcond(ig,ilev) = 0.  
+> c         END DO
+> c       END DO
+234a241,243
+> 
+> 
+> 
+449c458
+< !          zb(ig,1) = 0.
+---
+>           zb(ig,1) = 0.
+456c465
+<         else
+---
+>            else
+471c480
+<           if ((water).and.(iq.eq.igcm_h2o_vap)) then 
+---
+>           if ((water).and.(iq.eq.nqmx)) then 
+476,477d484
+<           else ! (re)-initialize zb(:,1)
+<              zb(1:ngrid,1)=0
+495,507c502
+< 
+<           if (water.and.(iq.eq.igcm_h2o_ice)) then
+<             ! special case for water ice tracer: do not include
+<             ! h2o ice tracer from surface (which is set when handling
+<             ! h2o vapour case (see further down).
+<             DO ig=1,ngrid
+<                 z1(ig)=1./(za(ig,1)+zb(ig,1)+
+<      $           zb(ig,2)*(1.-zd(ig,2)))
+<                 zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+<      $         zb(ig,2)*zc(ig,2)) *z1(ig)
+<             ENDDO
+<           else ! general case
+<             DO ig=1,ngrid
+---
+>           DO ig=1,ngrid
+513,514c508
+<             ENDDO
+<           endif ! of if (water.and.(iq.eq.igcm_h2o_ice))
+---
+>           ENDDO
+516c510
+<           IF ((water).and.(iq.eq.igcm_h2o_vap)) then 
+---
+>           IF ((water).and.(iq.eq.nqmx)) then 
+522c516
+<               pdqsdif(ig,igcm_h2o_ice)=rho(ig)*dryness(ig)*zcdv(ig)
+---
+>               pdqsdif(ig,nq)=rho(ig)*dryness(ig)*zcdv(ig)
+526d519
+< 
+529,530c522
+<                 if ((-pdqsdif(ig,igcm_h2o_ice)*ptimestep)
+<      &             .gt.pqsurf(ig,igcm_h2o_ice)) then
+---
+>               if ((-pdqsdif(ig,nq)*ptimestep).gt.pqsurf(ig,nq)) then
+532,533c524
+<                   pdqsdif(ig,igcm_h2o_ice)=
+<      &                         -pqsurf(ig,igcm_h2o_ice)/ptimestep
+---
+>                   pdqsdif(ig,nq) = -pqsurf(ig,nq)/ptimestep
+536c527
+<                   zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_h2o_vap)+
+---
+>                   zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+538c529
+<      $            (-pdqsdif(ig,igcm_h2o_ice)) *ptimestep) *z1(ig)
+---
+>      $            (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)
+540,541c531,532
+<                 endif   
+<               endif ! if (.not.watercaptag(ig))
+---
+>               endif   
+>               endif   
+543,544c534,535
+<                zq(ig,1,igcm_h2o_vap)=zq1temp(ig)
+<             ENDDO ! of DO ig=1,ngrid
+---
+>                zq(ig,1,iq)=zq1temp(ig)
+>             ENDDO
+550c541
+<           END IF ! of IF ((water).and.(iq.eq.igcm_h2o_vap))
+---
+>           END IF
+557,558c548,549
+<         enddo ! of do iq=1,nq
+<       end if ! of if(tracer)
+---
+>         enddo
+>       end if
+576c567
+<     
+---
+> 
+1c1
+<        SUBROUTINE watercloud(ngrid,nlay, ptimestep, 
+---
+>       SUBROUTINE watercloud(ngrid,nlay, ptimestep,
+3,5c3,4
+<      &                pq,pdq,pdqcloud,pdqscloud,pdtcloud,
+<      &                nq,naersize,tau,
+<      &                rnuclei,rice,nuice)
+---
+>      &                pq,pdq,pdqcloud,qsurf,pdqscloud,pdtcloud,
+>      &                nq,nsize,tau,icount,zls)
+17c16,19
+< c       
+---
+> c
+> c     WARNING : water vapor mixing ratio is assumed to be 
+> c     q(nqmx)
+> c
+19,21d20
+< c                  Francois Forget : change nuclei density & outputs   
+< c                  Ehouarn Millour: sept.2008, tracers are now handled
+< c                                   by name (and not fixed index)
+34d32
+< #include "comgeomfi.h"
+36,37c34,38
+< c   Inputs:
+< c   ------
+---
+> #include "fisice.h"
+> #include "comgeomfi.h"
+> c
+> c   arguments:
+> c   ----------
+39c40,41
+<       INTEGER ngrid,nlay
+---
+>       INTEGER ngrid,nlay,nsize
+>       INTEGER icount
+43d44
+<       REAL pdpsrf(ngrid)         ! tendance surf pressure
+46c47,48
+<       REAL pt(ngrid,nlay)        ! temperature at the middle of the layers (K)
+---
+>       REAL pdpsrf(ngrid)         ! tendance surf pressure
+>       REAL pt(ngrid,nlay)        ! temperature au centre des couches (K)
+48,59c50,59
+< 
+<       real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
+<       real pdq(ngrid,nlay,nq)    ! tendance avant condensation  (kg/kg.s-1)
+< 
+<       integer nq         ! nombre de traceurs 
+<       integer naersize   ! nombre de traceurs radiativement actifs (=naerkind)
+<       REAL tau(ngridmx,naersize)
+< 
+< c   Outputs:
+< c   -------
+< 
+<       real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1)
+---
+>       REAL pdtcloud(ngrid,nlay)  ! tendance temperature due a la chaleur latente
+>       REAL tau(ngridmx,nsize)
+>       REAL zls
+> 
+> c    Traceurs :
+>       integer nq                   ! nombre de traceurs 
+>       real pq(ngrid,nlay,nq)       ! traceur (kg/kg)
+>       real pdq(ngrid,nlay,nq)      ! tendance avant condensation  (kg/kg.s-1)
+>       real pdqcloud(ngrid,nlay,nq) ! tendance de la condesation H2O(kg/kg.s-1)
+>       real qsurf(ngrid,nq)
+61,68c61
+<       REAL pdtcloud(ngrid,nlay)    ! tendance temperature due a la chaleur latente
+< 
+<       REAL rnuclei(ngrid,nlay) ! Prescribed dust radius in each
+<                                !   layer (m)
+<       REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+<       REAL nuice(ngrid,nlay)   ! Estimated effective variance
+<                                !   of the size distribution
+< 
+---
+>       
+74c67
+<       INTEGER ig,iq,l
+---
+>       INTEGER ig,l
+75a69,70
+>       LOGICAL firstcall,improved
+>       SAVE firstcall
+77,80c72,75
+<       REAL zq(ngridmx,nlayermx,nqmx)  ! local value of tracers
+<       REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers
+<       REAL zqsat(ngridmx,nlayermx)    ! saturation
+<       REAL zt(ngridmx,nlayermx)       ! local value of temperature
+---
+>       REAL zq(ngridmx,nlayermx,nqmx)
+>       REAL zq0(ngridmx,nlayermx,nqmx)
+>       REAL zqsat(ngridmx,nlayermx)
+>       REAL zt(ngridmx,nlayermx)
+90c85
+<       REAL,PARAMETER :: To=273.15 ! reference temperature, T=273.15 K
+---
+>       REAL To
+96,98c91,93
+<       LOGICAL,SAVE :: firstcall=.true.
+< ! To use more refined microphysics, set improved to .true. 
+<       LOGICAL,PARAMETER :: improved=.true.
+---
+>       DATA firstcall/.true./
+> cc      DATA improved/.false./      ! Actionne une microphysique plus raffinee
+>       DATA improved/.true./
+99a95,96
+> c     Reference temperature, T=273,15 K
+>       data To/273.15/
+101c98,100
+< c     Pour diagnostique :
+---
+>       SAVE improved
+> 
+> c     POur diagnostique :
+103,104c102,117
+< c     REAL icetot(ngridmx)             ! Total mass of water ice (kg/m2)
+< c     REAL rave(ngridmx)               ! Mean crystal radius in a column (m)
+---
+>       REAL taucond(ngridmx,nlayermx)   ! taux de condensation (kg/kg/s-1)
+> ccc****WRF
+> c      REAL mtot(ngridmx)               ! Total mass of water vapor (kg/m2)
+> c      REAL icetot(ngridmx)             ! Total mass of water ice (kg/m2)
+> c      REAL rave(ngridmx)               ! Mean crystal radius in a column (m)
+> ccc****WRF
+>       REAL cloudmass(ngridmx,nlayermx) ! Integrated mass of water ice in each layer (kg/m2)
+>       REAL waterhem(2,3)
+> 
+>       REAL icetot2pm(ngridmx)
+>       REAL mtot2pm(ngridmx)
+>       REAL rave2pm(ngridmx)
+>       REAL qsurf2pm(ngridmx)
+>       INTEGER i,nit
+>       REAL ecart,loctime
+>       integer univtime,lon2pm(ngridmx)
+106c119,120
+<       INTEGER i
+---
+>       integer ig_vl2
+>       real latvl2,lonvl2
+108,112c122,123
+< ! indexes of water vapour, water ice and dust tracers:
+<       INTEGER,SAVE :: i_dust=0 ! dust
+<       INTEGER,SAVE :: i_h2o=0  ! water vapour
+<       INTEGER,SAVE :: i_ice=0  ! water ice
+<       CHARACTER(LEN=20) :: tracername ! to temporarly store text
+---
+>       logical tesfield  ! output of TES like data
+>       data tesfield /.false./
+118c129
+<         IF(ngrid.NE.ngridmx) THEN
+---
+>          IF(ngrid.NE.ngridmx) THEN
+124,152c135,169
+<         ENDIF
+<          
+<         if (nq.gt.nqmx) then
+<            write(*,*) 'stop in watercloud (nq.gt.nqmx)!'
+<            write(*,*) 'nq=',nq,' nqmx=',nqmx
+<            stop
+<         endif
+<          
+<         do iq=1,nqmx
+<           tracername=noms(iq)
+<           if (tracername(1:4).eq."dust") then
+<             i_dust=iq
+<           endif
+< !          if (tracername.eq."h2o_ice") then
+< !            i_ice=iq
+< !          endif
+< !          if (tracername.eq."h2o_vap") then
+< !            i_h2o=iq
+< !          endif
+<         enddo
+<         i_h2o=igcm_h2o_vap
+<         i_ice=igcm_h2o_ice
+<         
+<         write(*,*) "watercloud: i_dust=",i_dust
+<         write(*,*) "            i_ice=",i_ice
+<         write(*,*) "            i_h2o=",i_h2o
+<         
+<         firstcall=.false.
+<       ENDIF ! of IF (firstcall)
+---
+>          ENDIF
+>          firstcall=.false.
+>          if (tesfield) then
+>            latvl2= 47.57
+>            lonvl2= 134.26
+>            ig_vl2= 1+ int( (1.5-(latvl2-90.)*jjm/180.)  -2 )*iim +
+>      &              int(1.5+(lonvl2+180)*iim/360.)
+>            open(201,file='VL2_data')
+>            open(199,file='water_budgets')
+>            print*,'File water_budgets created'
+> c          Find the universal time corresponding to 2PM (TES obs)
+>            print*,'Universal time corresponding to 2PM (TES obs)'
+>            print*,'of each longitude - Used when iceparty is on.'
+>            print*,'2PM outputs are written in a specific file.'
+>            print*,'|   Longitude   |   U.T = 2PM LT   |'
+>            nit= 48
+>            do ig=1,ngridmx
+>              ecart=24.
+>              do i=1,nit-1
+>                loctime = i/float(nit)*24. + long(ig)*12./pi
+>                if (loctime.gt.24.) loctime = loctime - 24.
+>                if (loctime.lt.0)   loctime = loctime + 24.
+>                if (abs(14.-loctime).lt.ecart) then
+>                  ecart      = abs(14.-loctime)
+>                  lon2pm(ig) = i
+>                endif
+>              enddo
+>              if(int(lati(ig)*180./pi).eq.0) 
+>      *             print*,long(ig)/pi*180.,'|',lon2pm(ig)/2.
+>            enddo
+>            open(200,file='2pm_outputs',form='unformatted')
+>            print*,'File 2pm_outputs created'
+>            write(200) long,lati
+>          endif ! (tesfield)
+>       ENDIF
+164,175c181,192
+<         do ig=1,ngrid
+<           zq(ig,l,i_h2o)=pq(ig,l,i_h2o)+pdq(ig,l,i_h2o)*ptimestep
+<           zq(ig,l,i_h2o)=max(zq(ig,l,i_h2o),1.E-30) ! FF 12/2004 
+<           zq0(ig,l,i_h2o)=zq(ig,l,i_h2o)
+<           zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+<           masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+<           epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
+< 
+<           zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
+<           zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 
+<           zq0(ig,l,i_ice)=zq(ig,l,i_ice)
+<           rnuclei(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+---
+>           do ig=1,ngrid
+>             zq(ig,l,nq)=pq(ig,l,nq)+pdq(ig,l,nq)*ptimestep
+>             zq(ig,l,nq)=max(zq(ig,l,nq),1.E-30) ! FF 12/2004 
+>             zq0(ig,l,nq)=zq(ig,l,nq)
+>             zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+>             masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+>             epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
+>             if(iceparty) then
+>               zq(ig,l,nq-1)=pq(ig,l,nq-1)+pdq(ig,l,nq-1)*ptimestep
+>               zq(ig,l,nq-1)=max(zq(ig,l,nq-1),0.) ! FF 12/2004 
+>               zq0(ig,l,nq-1)=zq(ig,l,nq-1)
+>               rdust(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+179c196
+< c         dont le rayon moyen est prescrit par rnuclei.
+---
+> c         dont le rayon moyen est prescrit par rdust.
+181,200c198,218
+<           if ((dustbin.eq.1).and.(.not.(doubleq))) then
+<             zq(ig,l,i_dust)=pq(ig,l,i_dust)+pdq(ig,l,i_dust)*ptimestep
+<               dustcores(ig,l)=max(zq(ig,l,i_dust)/
+<      &         (rho_dust*4./3.*pi*radius(i_dust)**3.),1.e-9)
+<           else
+<             dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+<      &     2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+< 
+< c            TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+< c              dustcores(ig,l) = dustcores(ig,l) / 27. ! reduction facteur 3
+<             dustcores(ig,l) = dustcores(ig,l) / 8. ! reduction facteur 2
+<           endif
+<           rice(ig,l)=CBRT( ( zq(ig,l,i_ice)/rho_ice+
+<      &       dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3. )
+<      &       / (dustcores(ig,l)*4./3.*pi) )
+<           rice(ig,l)=max(rice(ig,l),rnuclei(ig,l))
+< c         Effective variance of the size distribution
+<           nuice(ig,l)=0.1
+<         enddo ! of do ig=1,ngrid
+<       enddo ! of dol=1,nlay
+---
+>               if ((dustbin.eq.1).and..not.(doubleq)) then
+>                 zq(ig,l,1)=pq(ig,l,1)+pdq(ig,l,1)*ptimestep
+>                 dustcores(ig,l)=max(zq(ig,l,1)/
+>      &           (rho_dust*4./3.*pi*radius(1)**3.),1.e-9)
+>               else
+>                 dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+>      &       2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+> 
+> !!!PATCH WATER
+> c            TEMPORAIRE : rÃ©duction du nombre de nuclei FF 04/2008 :
+>                 dustcores(ig,l) = dustcores(ig,l) / 8.
+>                 ! reduction facteur 2
+> 
+>               endif
+>               rice(ig,l)=CBRT( ( zq(ig,l,nq-1)/rho_ice+
+>      &         dustcores(ig,l)*(4./3.)*pi*rdust(ig,l)**3. )
+>      &         / (dustcores(ig,l)*4./3.*pi) )
+>               rice(ig,l)=max(rice(ig,l),rdust(ig,l))
+>             endif
+>           enddo
+>       enddo
+204a223
+>       call zerophys(ngrid,mtot)
+206,207c225,227
+< c     call zerophys(ngrid,icetot)
+< c     call zerophys(ngrid,rave)
+---
+>       call zerophys(ngrid,icetot)
+>       call zerophys(ngrid,rave)
+>       call zerophys(ngrid,cloudmass)
+218a239,246
+> c       (Pour diagnostic seulement !)
+>         if(.not.iceparty)then
+>         do l=1, nlay
+>           do ig=1,ngridmx
+>             taucond(ig,l)= max((zq(ig,l,nq)-zqsat(ig,l))/ptimestep,0.)
+>           end do
+>         end do
+>         endif
+220,224d247
+< c       Iceparty is not used anymore: water=>iceparty (JBM).
+< c       if(iceparty) then
+< 
+<         do l=1,nlay
+<           do ig=1,ngrid
+226,232c249,259
+<           IF (improved) then
+< c         Improved microphysics scheme
+< c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< 
+<            Ctot = zq(ig,l,i_h2o) + zq(ig,l,i_ice)
+<            ph2o = zq(ig,l,i_h2o) * 44. / 18. * pplay(ig,l)
+<            satu = zq(ig,l,i_h2o) / zqsat(ig,l)
+---
+>         if(iceparty) then
+>           do l=1,nlay
+>             do ig=1,ngrid
+> 
+>             If (improved) then
+> c           Improved microphysics scheme
+> c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> 
+>              Ctot = zq(ig,l,nq) + zq(ig,l,nq-1)
+>              ph2o = zq(ig,l,nq) * 44. / 18. * pplay(ig,l)
+>              satu = zq(ig,l,nq) / zqsat(ig,l)
+234c261
+<            call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+---
+>              call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+236c263
+<            Cste = ptimestep * 4. * pi * rice(ig,l)
+---
+>              Cste = ptimestep * 4. * pi * rice(ig,l)
+238,260c265,287
+<            up   = zq(ig,l,i_h2o) + Cste * gr * seq
+<            dwn  =    1.       + Cste * gr / zqsat(ig,l)
+<            newvap = min(up/dwn,Ctot)
+< 
+<            gr  = gr * ( newvap/zqsat(ig,l) - seq )
+<            dzq = min( max( Cste * gr,-zq(ig,l,i_ice) ) 
+<      *             , zq(ig,l,i_h2o) )
+< 
+< c          Nucleation (sat ratio must be larger than a critical value)
+< c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+<            if (satu.gt.1.) then
+<              if (satu.le.1.4.and.zq(ig,l,i_ice).lt.1.e-8) 
+<      *          dzq = 0.
+<            endif
+< 
+<            ELSE
+< c          Old version
+< c          ~~~~~~~~~~~
+<            if (zq(ig,l,i_h2o).ge.zqsat(ig,l))then  !  Condensation
+<              dzq=zq(ig,l,i_h2o)-zqsat(ig,l)                
+<            elseif(zq(ig,l,i_h2o).lt.zqsat(ig,l))then  ! Sublimation
+<              dzq=-min(zqsat(ig,l)-zq(ig,l,i_h2o),zq(ig,l,i_ice))
+<            endif
+---
+>              up   = zq(ig,l,nq) + Cste * gr * seq
+>              dwn  =    1.       + Cste * gr / zqsat(ig,l)
+>              newvap = min(up/dwn,Ctot)
+> 
+>              gr  = gr * ( newvap/zqsat(ig,l) - seq )
+>              dzq = min( max( Cste * gr,-zq(ig,l,nq-1) ) 
+>      *             , zq(ig,l,nq) )
+> 
+> c            Nucleation (sat ratio must be larger than a critical value)
+> c            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+>              if (satu.gt.1.) then
+>                if (satu.le.1.4.and.zq(ig,l,nq-1).lt.1.e-8) 
+>      *            dzq = 0.
+>              endif
+> 
+>             Else
+> c           Old version
+> c           ~~~~~~~~~~~
+>              if (zq(ig,l,nq).ge.zqsat(ig,l))then  !  Condensation
+>                dzq=zq(ig,l,nq)-zqsat(ig,l)                
+>              elseif(zq(ig,l,nq).lt.zqsat(ig,l))then  ! Sublimation
+>                dzq=-min(zqsat(ig,l)-zq(ig,l,nq),zq(ig,l,nq-1))
+>              endif
+262c289
+<            ENDIF ! of IF (improved)
+---
+>             Endif
+266,271c293,294
+<             zq(ig,l,i_ice)=zq(ig,l,i_ice)+dzq
+<             zq(ig,l,i_h2o)=zq(ig,l,i_h2o)-dzq
+< 
+<             rice(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_ice
+<      &       +dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3.)
+<      &       /(dustcores(ig,l)*4./3.*pi) ), rnuclei(ig,l)) 
+---
+>             zq(ig,l,nq-1)=zq(ig,l,nq-1)+dzq
+>             zq(ig,l,nq)=zq(ig,l,nq)-dzq
+273,274c296,304
+<             enddo ! of do ig=1,ngrid
+<           enddo ! of do l=1,nlay
+---
+>             rice(ig,l)=max( CBRT ( (zq(ig,l,nq-1)/rho_ice
+>      &       +dustcores(ig,l)*(4./3.)*pi*rdust(ig,l)**3.)
+>      &       /(dustcores(ig,l)*4./3.*pi) ), rdust(ig,l)) 
+> 
+>             if(activice.and.pclc(ig).gt.0)
+>      &        rice(ig,l)=rice(ig,l)/CBRT(pclc(ig))
+>               
+>             enddo
+>           enddo
+276,279c306
+< c       The following part have been commented because iceparty
+< c           is not used anymore: water=>iceparty (JBM).
+< 
+< c       else   ! if not iceparty
+---
+>         else   ! if not iceparty
+283,292c310,318
+< c         do l=nlay,2, -1
+< c          do ig=1,ngrid
+< c           if (zq(ig,l,i_h2o).gt.zqsat(ig,l))then 
+< c             zq(ig,l-1,i_h2o)= zq(ig,l-1,i_h2o)+
+< c    &                          (zq(ig,l,i_h2o)-zqsat(ig,l))
+< c    &          *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+< c             zq(ig,l,i_h2o)=zqsat(ig,l)
+< c           endif
+< c          enddo
+< c         enddo
+---
+>           do l=nlay,2, -1
+>              do ig=1,ngrid
+>              if (zq(ig,l,nq).gt.zqsat(ig,l))then 
+>                zq(ig,l-1,nq) =  zq(ig,l-1,nq)+(zq(ig,l,nq)-zqsat(ig,l))
+>      &          *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+>                zq(ig,l,nq)=zqsat(ig,l)
+>              endif
+>              enddo
+>           enddo
+296,302c322,328
+< c         do ig=1,ngridmx
+< c           if (zq(ig,1,i_h2o).gt.zqsat(ig,1))then
+< c             pdqscloud(ig,i_ice)=(zq(ig,1,i_h2o)-zqsat(ig,1))
+< c    &           *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep)
+< c             zq(ig,1,i_h2o)=zqsat(ig,1)
+< c           endif
+< c         enddo
+---
+>           do ig=1,ngridmx
+>               if (zq(ig,1,nq).gt.zqsat(ig,1))then
+>                  pdqscloud(ig,nq)= (zq(ig,1,nq)-zqsat(ig,1))
+>      &         *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep)
+>                  zq(ig,1,nq)=zqsat(ig,1)
+>               endif
+>           end do
+304c330
+< c       endif   ! of if (iceparty)
+---
+>         endif   ! (iceparty)
+310,313c336,340
+<             pdqcloud(ig,l,i_h2o)=(zq(ig,l,i_h2o)
+<      &                              -zq0(ig,l,i_h2o))/ptimestep
+<             pdqcloud(ig,l,i_ice) =
+<      &        (zq(ig,l,i_ice) - zq0(ig,l,i_ice))/ptimestep
+---
+>             pdqcloud(ig,l,nq) = (zq(ig,l,nq) - zq0(ig,l,nq))/ptimestep
+>             if(iceparty) then
+>               pdqcloud(ig,l,nq-1) =
+>      &        (zq(ig,l,nq-1) - zq0(ig,l,nq-1))/ptimestep
+>             endif
+315c342
+<             pdtcloud(ig,l)=-pdqcloud(ig,l,i_h2o)*lw/cpp
+---
+>             pdtcloud(ig,l)=-pdqcloud(ig,l,nq)*lw/cpp
+333c360
+< ! NB: for diagnostics use zq(), the updated value of tracers
+---
+>         univtime = icount - int(float(icount)/48.) * 48
+335,336c362,371
+< c        do ig=1,ngridmx
+< c         do l=1 ,nlay
+---
+> c       if "tesfield"
+> c       ~~~~~~~~~~~~~
+>         if (tesfield.and.mod(icount,12).eq.0) 
+>      .          call zerophys(6,waterhem)
+> c****WRF: ligne trop longue        
+>          do ig=1,ngridmx
+>           do l=1 ,nlay
+> c           masse de vapeur d'eau dans la couche l
+>             mtot(ig)=mtot(ig)+pq(ig,l,nq)*masse(ig,l)
+>             if(iceparty) then
+338c373
+< c           icetot(ig)=icetot(ig)+masse(ig,l)*zq(ig,l,i_ice)
+---
+>               icetot(ig)=icetot(ig)+masse(ig,l)*pq(ig,l,nq-1)
+340,345c375,483
+< c           rave(ig)=rave(ig)+masse(ig,l)*zq(ig,l,i_ice)*rice(ig,l)
+< c         enddo
+< c         rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+< c         if (icetot(ig)*1000.lt.0.01) rave(ig)=0.
+< c        enddo   ! (ngridmx)
+< c**************************************************
+---
+>               rave(ig)=rave(ig)+masse(ig,l)*pq(ig,l,nq-1)*rice(ig,l)
+>               cloudmass(ig,l)=masse(ig,l)*pq(ig,l,nq-1)
+>             endif
+>           enddo
+>           if(iceparty) then
+>             rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+>             if (icetot(ig)*1000.lt.0.01) rave(ig)=0.
+>           endif
+>           if (tesfield) then
+>             if (univtime.eq.lon2pm(ig)) mtot2pm(ig)   = mtot(ig)
+>             if (univtime.eq.lon2pm(ig).and.iceparty) 
+>      *        icetot2pm(ig) = icetot(ig)
+>             if (univtime.eq.lon2pm(ig).and.iceparty) 
+>      *        rave2pm(ig)   = rave(ig)
+>             if (univtime.eq.lon2pm(ig)) qsurf2pm(ig)  = qsurf(ig,nqmx)
+>         endif
+> 
+> c       Outputs total mass of water and clouds    *
+> c       ******************************************
+>           IF (tesfield.and.mod(icount,12).EQ.0) THEN
+>            if (int(lati(ig)*180/pi).gt.0) then
+>              waterhem(1,1)=waterhem(1,1)+area(ig)*mtot(ig)
+>              waterhem(1,2)=waterhem(1,2)+area(ig)*qsurf(ig,nqmx)
+>             if (iceparty)waterhem(1,3)=waterhem(1,3)+area(ig)*icetot(ig)
+>            endif
+>            if (int(lati(ig)*180/pi).lt.0) then
+>              waterhem(2,1)=waterhem(2,1)+area(ig)*mtot(ig)
+>              waterhem(2,2)=waterhem(2,2)+area(ig)*qsurf(ig,nqmx)
+>             if (iceparty)waterhem(2,3)=waterhem(2,3)+area(ig)*icetot(ig)
+>            endif
+>            if (int(lati(ig)*180/pi).eq.0) then
+>              waterhem(1,1)=waterhem(1,1)+area(ig)*mtot(ig)/2.
+>              waterhem(2,1)=waterhem(2,1)+area(ig)*mtot(ig)/2.
+>              waterhem(1,2)=waterhem(1,2)+area(ig)*qsurf(ig,nqmx)/2.
+>              waterhem(2,2)=waterhem(2,2)+area(ig)*qsurf(ig,nqmx)/2.
+>              if (iceparty) then
+>                waterhem(1,3)=waterhem(1,3)+area(ig)*icetot(ig)/2.
+>                waterhem(2,3)=waterhem(2,3)+area(ig)*icetot(ig)/2.
+>              endif
+>            endif
+>           ENDIF ! (total mass)
+>         enddo   ! (ngridmx)
+> 
+>         if (tesfield.and.mod(icount,12).eq.0) then
+>           write(199,6000)zls*180./pi,waterhem(1,1),waterhem(1,2),
+>      &    waterhem(1,3),waterhem(2,1),waterhem(2,2),waterhem(2,3)
+> !6000      format(f8.3,x,6(e12.5,x))
+> !!!!!!!!!!!!!!!!g95
+> 6000      format(f8.3,1x,6(e12.5,1x))
+>           write(201,6001) zls*180./pi,pplev(ig_vl2,1),icetot(ig_vl2)
+>      &    ,zt(ig_vl2,1)
+> !6001      format(f8.3,x,3(e12.5,x))
+> !!!!!!!!!!!!!!!!g95
+> 6001      format(f8.3,1x,3(e12.5,1x))
+>         endif
+> 
+> ***************************************************
+> *       Write outputs at 2PM LT in a dedicated file
+> ***************************************************
+>         if (tesfield) then
+>           if (mod(icount,48).eq.0.and.icount.ne.1.and.iceparty) then
+>             print*,'ecriture dans 2pm_outputs'
+>             write(200) zls
+>             write(200) mtot2pm
+>             if (iceparty) write(200) icetot2pm
+>             write(200) qsurf2pm
+>             if (iceparty) write(200) rave2pm
+>           endif
+>         endif
+> 
+> c ******************************************    
+> c      Output in diagfi
+> c ******************************************    
+> 
+>       if (ngrid.gt.1) then
+> 
+> c          CALL WRITEDIAGFI(ngridmx,'mtot',
+> c     &  'total mass of water vapor','kg/m2',2,mtot)
+> c
+> c         if (callstats) then
+> c            call wstats(ngrid,"mtot",
+> c     .   "total mass of water vapor","kg/m2",2,mtot)
+> c         endif
+> c
+> cc        if(.not.iceparty)
+> cc     &  call WRITEDIAGFI(ngridmx,'taucond',
+> cc     &  'taux cond H2O ice','kg/kg/s',3,taucond)
+> cc
+> c         if(iceparty) then
+> c            CALL WRITEDIAGFI(ngridmx,'icetot',
+> c     &    'total mass of water ice','kg/m2',2,icetot)
+> c           if (callstats) then
+> c              call wstats(ngrid,"icetot",
+> c     .        "total mass of water ice","kg/m2",2,icetot)
+> c           endif
+> cc          CALL WRITEDIAGFI(ngridmx,'cloudmass',
+> cc     &    'mass of water ice/layer','kg/m2',3,cloudmass)
+> cc          CALL WRITEDIAGFI(ngridmx,'rice','ice radius',
+> cc     &    'meter',3,rice)
+> cc          CALL WRITEDIAGFI(ngridmx,'rave','Mean ice radius',
+> cc     &    'meter',2,rave)
+> c         endif
+> 
+>       else
+> 
+> c          CALL WRITEG1D(ngridmx,1,mtot,'gas','kg/m2')
+> c          CALL WRITEG1D(ngridmx,1,icetot,'ice','kg/m2')
+> c          call WRITEG1D(ngridmx,nlay,rice,'rice','um')
+> c          call WRITEG1D(ngridmx,nlay,dustcores,'pouss','#/layer')
+346a485
+>       endif
+351d489
+<  
+1c1
+<       SUBROUTINE watersat(naersize,t,p,qsat)
+---
+>       SUBROUTINE watersat(nsize,t,p,qsat)
+17,18c17,18
+<       integer naersize 
+<       real t(naersize) , p(naersize)
+---
+>       integer nsize 
+>       real t(nsize) , p(nsize)
+20c20
+<       real qsat(naersize)
+---
+>       real qsat(nsize)
+31c31
+<       do i=1,naersize
+---
+>       do i=1,nsize
+5,8c5,8
+< #include "dimensions.h"
+< #include "dimphys.h"
+< #include "statto.h"
+< #include "netcdf.inc"
+---
+> include "dimensions.h"
+> include "dimphys.h"
+> include "statto.h"
+> include "netcdf.inc"
+1,21c1,21
+< !     Radiative characteristics of the aerosols
+< ! 
+< !   Shortwave
+< !   ~~~~~~~~~
+< ! 
+< ! tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+< ! in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+< 
+< ! For the "naerkind" kind of aerosol radiative properties : 
+< ! QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+< ! omegavis   :  sinle scattering albedo     <--- For both solar bands
+< ! gvis       :  assymetry factor            <--- For both solar bands
+< ! 
+< !   Longwave
+< !   ~~~~~~~~
+< ! 
+< ! For the "naerkind" kind of aerosol radiative properties : 
+< ! QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+< ! omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+< ! gIR      :  mean assymetry factor         <--- For the nir bandes IR
+< ! 
+---
+> C*    Radiative characteristics of the aerosols
+> C
+> C   Shortwave
+> c   ~~~~~~~~~
+> c
+> c tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+> c in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+> 
+> c For the "naerkind" kind of aerosol radiative properties : 
+> C QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+> C omegavis   :  sinle scattering albedo     <--- For both solar bands
+> C gvis       :  assymetry factor            <--- For both solar bands
+> c
+> C   Longwave
+> c   ~~~~~~~~
+> c
+> c For the "naerkind" kind of aerosol radiative properties : 
+> c QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+> c omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+> c gIR      :  mean assymetry factor         <--- For the nir bandes IR
+> c
+23,50c23,26
+<       real QVISsQREF(nsun,naerkind,nsizemax)
+<       real omegavis(nsun,naerkind,nsizemax)
+<       real gvis(nsun,naerkind,nsizemax)
+<       real QIRsQREF(nir,naerkind,nsizemax)
+<       real omegaIR(nir,naerkind,nsizemax)
+<       real gIR(nir,naerkind,nsizemax)
+< 
+< ! Actual number of grain size classes in each domain for a
+< !   given aerosol:
+< 
+<       INTEGER          :: nsize(naerkind,2)
+< 
+< ! Particle size axis (depend on the kind of aerosol and the
+< !   radiation domain)
+< 
+<       REAL :: radiustab(naerkind,2,nsizemax)
+< 
+< ! Extinction coefficient at reference wavelengths;
+< !   These wavelengths are defined in dimradmars.h, and called
+< !   longrefvis and longrefir.
+< 
+<       REAL             :: QREFvis(naerkind,nsizemax)
+<       REAL             :: QREFir(naerkind,nsizemax)
+<       REAL             :: omegaREFvis(naerkind,nsizemax)
+<       REAL             :: omegaREFir(naerkind,nsizemax)
+< 
+< ! For Fortran 77/Fortran 90 compliance always use line continuation
+< ! symbols '&' in columns 73 and 6
+---
+>       real QVISsQREF(nsun,naerkind)
+>       real omegavis(nsun,naerkind),gvis(nsun,naerkind)
+>       real QIRsQREF(nir,naerkind)
+>       real omegaIR(nir,naerkind),gIR(nir,naerkind)
+52,55c28,29
+<       COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,                     &
+<      &              QIRsQREF,omegaIR,gIR,                               &
+<      &              QREFvis,QREFir,omegaREFvis,omegaREFir,              &
+<      &              nsize,radiustab
+---
+>       COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,
+>      &              QIRsQREF,omegaIR,gIR
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/diff.log.h	(revision 46)
@@ -0,0 +1,331 @@
+1,2c1,2
+< !-----------------------------------------------------------------------
+< ! INCLUDE "comcstfi.h"
+---
+> c-----------------------------------------------------------------------
+> c INCLUDE comcstfi.h
+4c4,5
+<       common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+---
+>       COMMON/comcstfi/
+>      * pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+6c7
+<       real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+---
+>       REAL pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+4,11c4,10
+< ! ngridmx : number of horizontal grid points
+< ! note: the -1/jjm term will be 0; unless jj=1
+<       integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
+< ! nlayermx : number of atmospheric layers
+<       integer, parameter :: nlayermx = llm 
+< ! nsoilmx : number of subterranean layers
+< !EM: old soil routine:      integer, parameter :: nsoilmx = 10
+<       integer, parameter :: nsoilmx = 18 
+---
+> 
+>          INTEGER, parameter :: wiim=44
+>          INTEGER, parameter :: wjjm=44
+>          INTEGER, PARAMETER :: ngridmx=1936
+>          INTEGER, parameter :: nlayermx=70
+>          INTEGER, PARAMETER :: nsoilmx=10
+> 	
+12a12,13
+> 
+> 	 
+1,3c1,21
+< ! ----------------------------------------------------------------------
+< ! -----------------------------------------------------------------------
+< !   INCLUDE 'dimradmars.h'
+---
+> c-----------------------------------------------------------------------
+> c------------------------------------------------------------------------
+> c   INCLUDE 'dimradmars.h'
+> 
+> c   Declaration and initialisation or radiative transfer calculations
+> c------------------------------------------------------------------------
+> c------------------------------------------------------------------------
+> 
+> c Splitting of horizontal grid (to reduce program size on workstation)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c nflev: number of vertical layer
+> c ndlon: nombre de points de la grille horizontale
+> c NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+> c ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
+> 
+>       INTEGER  NFLEV,NDLON, ndomainsz, NDLO2
+> 
+> c        parameter (ndomainsz=ngridmx)
+> cc       parameter (ndomainsz=(ngridmx-1)/20 + 1)
+> cc      parameter (ndomainsz=(ngridmx-1)/5 + 1)
+>         parameter (ndomainsz=(ngridmx-1)/100 + 1)
+5,14c23,24
+< !   Declaration and initialisation or radiative transfer calculations
+< !------------------------------------------------------------------------
+< !------------------------------------------------------------------------
+< 
+< ! nflev: number of vertical layer
+< ! ndlon,ndlo2: number of horizontal points
+< 
+<       INTEGER  NFLEV,NDLON,NDLO2
+< 
+<       parameter (NFLEV=nlayermx,NDLON=ngridmx)
+---
+> 	
+>       parameter (NFLEV=nlayermx,NDLON=ndomainsz)	! avec decoupage 
+17,22d26
+< ! Number of kind of tracer radiative properties 
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! (ex: naerkind=1 if you use one dust mode without ice ...)
+< ! (ex: naerkind=2 if you use one dust mode and active ice ...)
+<       integer naerkind
+<       parameter (naerkind=1)
+24,27c28
+< ! Reference wavelengths used to compute reference optical depth (m)
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< 
+<       REAL longrefir(naerkind),longrefvis(naerkind)
+---
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+28a30
+>       REAL longrefir,longrefvis
+36,37c38,39
+< ! Definition of spectral intervals at thermal infrared wavelengths (LW)
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c Definition of spectral intervals at thermal infrared wavelengths (LW)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+43,47c45,49
+< !  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+< !      iir=1 : central 15um CO2 bands \    
+< !      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+< !      iir=3 : 9 um band [long1ir - long1co2]
+< !      iir=4 : Far IR    [long2co2 - long2ir]
+---
+> c  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+> c      iir=1 : central 15um CO2 bands \    
+> c      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+> c      iir=3 : 9 um band [long1ir - long1co2]
+> c      iir=4 : Far IR    [long2co2 - long2ir]
+49,50c51,52
+< !  Definition of spectral interval at solar wavelengths (SW)
+< !  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+---
+> c  Definition of spectral interval at solar wavelengths (SW)
+> c  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+52c54
+< !  Boundaries of spectral intervals (m) : 
+---
+> c  Boundaries of spectral intervals (m) : 
+54c56
+< !  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+---
+> c  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+56c58
+< !  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+---
+> c  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+59,77c61,76
+< ! Maximum number of grain size classes
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! This parameter has to be set to the maximum number of particle
+< !   sizes contained in the optical parameter database; For example,
+< !   if only one grain size is used to describe dust, and 30 are used
+< !   to describe water-ice crystals in the visible and 15 in the IR,
+< !   nsizemax has to be set to 30.
+< ! If only one grain size is considered for all the aerosols, set
+< !   this parameter to 1 and convolution will be turned off during
+< !   the radiative calculations.
+< 
+< !     INTEGER, PARAMETER :: nsizemax = 60
+<       INTEGER, PARAMETER :: nsizemax = 1
+< 
+< ! Various initialisation for LW radiative code
+< ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+< ! npademx : nombre de coef de pade 
+< ! nabsmx : ?
+< ! nt_pademx : nombre d'intervalles de temperature pour pade
+---
+> c Reference wavelengths used to compute reference dust optical depth (m)
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+>       PARAMETER (longrefir=9.E-6,longrefvis=0.67E-6)
+> 
+> c Number of kind of tracer radiative properties 
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c (ex: naerkind=1 if you use one dust mode without ice ...)
+> c (ex: naerkind=2 if you use one dust mode and active ice ...)
+>       integer naerkind        
+>       parameter (naerkind=1)
+> 
+> c Various initialisation for LW radiative code
+> c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+> c npademx : nombre de coef de pade 
+> c nabsmx : ?
+> c nt_pademx : nombre d'intervalles de temperature pour pade
+1,5c1,5
+<       COMMON/surfdat/albedodat(ngridmx),                                &
+<      &   phisfi(ngridmx),albedice(2),emisice(2),emissiv,                &
+<      &   iceradius(2) , dtemisice(2),                                   &
+<      &   zmea(ngridmx),zstd(ngridmx),                                   &
+<      &   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+---
+>       COMMON/surfdat/albedodat(ngridmx),inertiedat(ngridmx),
+>      s   phisfi(ngridmx),albedice(2),emisice(2),emissiv,
+>      s   iceradius(2) , dtemisice(2),
+>      s   zmea(ngridmx),zstd(ngridmx),
+>      s   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+7,14c7,8
+<       real albedodat ! albedo of bare ground
+< ! Ehouarn: moved inertiedat to comsoil.h
+< !      real inertiedat, ! thermal inertia
+<       real phisfi ! geopotential at ground level
+<       real albedice
+<       real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+<       real emissiv
+<       real iceradius , dtemisice
+---
+>       REAL albedodat,inertiedat,phisfi,albedice,emisice,emissiv,
+>      s   iceradius , dtemisice
+1,2c1,2
+< !-----------------------------------------------------------------------
+< ! INCLUDE 'tracer.h'
+---
+> c-----------------------------------------------------------------------
+> c INCLUDE 'tracer.h'
+4c4
+<       character*20  noms(nqmx)  ! name of the tracer
+---
+>       character*10  noms(nqmx)  ! name of the tracer
+7d6
+<       real rho_q(nqmx)    ! tracer densities (kg.m-3)
+21,52c20
+< ! tracer indexes: these are initialized in initracer and should be 0 if the
+< !                 corresponding tracer does not exist
+<       ! dust
+<       integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+<       ! dust, special doubleq case
+<       integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+<       integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+<       ! water
+<       integer :: igcm_h2o_vap ! water vapour
+<       integer :: igcm_h2o_ice ! water ice
+<       ! chemistry:
+<       integer :: igcm_co2
+<       integer :: igcm_co
+<       integer :: igcm_o
+<       integer :: igcm_o1d
+<       integer :: igcm_o2
+<       integer :: igcm_o3
+<       integer :: igcm_h
+<       integer :: igcm_h2
+<       integer :: igcm_oh
+<       integer :: igcm_ho2
+<       integer :: igcm_h2o2
+<       integer :: igcm_n2
+<       integer :: igcm_ar
+<       
+<       ! other tracers
+<       integer :: igcm_ar_n2 ! for simulations using co2 +neutral gas
+< 
+< 
+< ! NB: to keep commons aligned: 
+< !     split them in groups (reals, integers and characters)
+<       COMMON/tracer/radius,rho_q,qext,alpha_lift,alpha_devil,mmol,      &
+---
+>       COMMON/tracer/radius,qext,alpha_lift,alpha_devil,noms,mmol,
+54,60c22
+<       COMMON/tracer2/
+<      & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &
+<      & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+<      & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+<      & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+<       COMMON/tracer3/noms
+< !-----------------------------------------------------------------------
+---
+> c-----------------------------------------------------------------------
+1,21c1,21
+< !     Radiative characteristics of the aerosols
+< ! 
+< !   Shortwave
+< !   ~~~~~~~~~
+< ! 
+< ! tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+< ! in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+< 
+< ! For the "naerkind" kind of aerosol radiative properties : 
+< ! QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+< ! omegavis   :  sinle scattering albedo     <--- For both solar bands
+< ! gvis       :  assymetry factor            <--- For both solar bands
+< ! 
+< !   Longwave
+< !   ~~~~~~~~
+< ! 
+< ! For the "naerkind" kind of aerosol radiative properties : 
+< ! QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+< ! omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+< ! gIR      :  mean assymetry factor         <--- For the nir bandes IR
+< ! 
+---
+> C*    Radiative characteristics of the aerosols
+> C
+> C   Shortwave
+> c   ~~~~~~~~~
+> c
+> c tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+> c in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+> 
+> c For the "naerkind" kind of aerosol radiative properties : 
+> C QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+> C omegavis   :  sinle scattering albedo     <--- For both solar bands
+> C gvis       :  assymetry factor            <--- For both solar bands
+> c
+> C   Longwave
+> c   ~~~~~~~~
+> c
+> c For the "naerkind" kind of aerosol radiative properties : 
+> c QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+> c omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+> c gIR      :  mean assymetry factor         <--- For the nir bandes IR
+> c
+23,50c23,26
+<       real QVISsQREF(nsun,naerkind,nsizemax)
+<       real omegavis(nsun,naerkind,nsizemax)
+<       real gvis(nsun,naerkind,nsizemax)
+<       real QIRsQREF(nir,naerkind,nsizemax)
+<       real omegaIR(nir,naerkind,nsizemax)
+<       real gIR(nir,naerkind,nsizemax)
+< 
+< ! Actual number of grain size classes in each domain for a
+< !   given aerosol:
+< 
+<       INTEGER          :: nsize(naerkind,2)
+< 
+< ! Particle size axis (depend on the kind of aerosol and the
+< !   radiation domain)
+< 
+<       REAL :: radiustab(naerkind,2,nsizemax)
+< 
+< ! Extinction coefficient at reference wavelengths;
+< !   These wavelengths are defined in dimradmars.h, and called
+< !   longrefvis and longrefir.
+< 
+<       REAL             :: QREFvis(naerkind,nsizemax)
+<       REAL             :: QREFir(naerkind,nsizemax)
+<       REAL             :: omegaREFvis(naerkind,nsizemax)
+<       REAL             :: omegaREFir(naerkind,nsizemax)
+< 
+< ! For Fortran 77/Fortran 90 compliance always use line continuation
+< ! symbols '&' in columns 73 and 6
+---
+>       real QVISsQREF(nsun,naerkind)
+>       real omegavis(nsun,naerkind),gvis(nsun,naerkind)
+>       real QIRsQREF(nir,naerkind)
+>       real omegaIR(nir,naerkind),gIR(nir,naerkind)
+52,55c28,29
+<       COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,                     &
+<      &              QIRsQREF,omegaIR,gIR,                               &
+<      &              QREFvis,QREFir,omegaREFvis,omegaREFir,              &
+<      &              nsize,radiustab
+---
+>       COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,
+>      &              QIRsQREF,omegaIR,gIR
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimphys.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimphys.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimphys.h	(revision 46)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+
+         INTEGER, parameter :: wiim=60
+         INTEGER, parameter :: wjjm=60
+         INTEGER, PARAMETER :: ngridmx=3600
+         INTEGER, parameter :: nlayermx=60
+         INTEGER, PARAMETER :: nsoilmx=10
+	
+!-----------------------------------------------------------------------
+
+	 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimradmars.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimradmars.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dimradmars.h	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/dimradmars.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustdevil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustdevil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustdevil.F	(revision 46)
@@ -0,0 +1,250 @@
+      SUBROUTINE dustdevil(ngrid,nlay,nq, pplev,pu,pv,pt, ptsurf,pq2,
+     &                pdqdev,pdqs_dev)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c
+c  VERSION SPECIAL TRACEURS :
+c  Parameterization of dust devil activities
+c  to estimate dust lifting
+c  The dust devil activity is estimated based on 
+c  Renno et al. 1998 (JAS 55, 3244-3252)  
+c
+c  It is proportional to (1-b)*Fs
+c
+c  With b= [ps**(rcp+1) - ptop**(rcp+1)] / [(ps-ptop)*(rcp+1)* ps**rcp]
+c  with ptop pressure of the top of the boundary layer
+c       rcp = R/cp
+c
+c  and Fs the surface sensible heat flux = Cd*|U|*(T(1) -Tsurf)
+c       
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"      
+c#include "comconst.h"        ! TEMPORAIRE AVEC ANLDEVIL !!!!
+#include "planete.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pplev(ngrid,nlay+1)
+      REAL pt(ngrid,nlay)
+      REAL pu(ngrid,nlay)
+      REAL pv(ngrid,nlay)
+      REAL pq2(ngrid,nlay+1)
+      REAL ptsurf(ngrid)
+
+c    Traceurs :
+      integer nq 
+      real pdqdev(ngrid,nlay,nq) 
+      real pdqs_dev(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ig,l,iq
+      real Cd, z1
+      save Cd
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+
+      REAL devila(ngridmx)
+      integer ltop(ngridmx)
+      real b,rho,Fs,wind
+
+
+
+      REAL  q2top , seuil
+      SAVE  q2top , seuil
+      DATA q2top/.5/ ! value of q2 at the top of PBL
+      DATA seuil/.3/ ! value of minimum dust devil activity for dust lifting
+
+
+      DATA firstcall/.true./
+
+c   TEMPORAIRE AVEC ANLDEVIL : *************
+c        real b_diag(ngridmx)
+c       real localtime(ngridmx)
+c       common/temporaire/localtime
+c      real ztop(ngridmx),magwind(ngridmx),t1(ngridmx)
+c      real rcp ,cpp
+c      rcp = kappa
+c      cpp = r/rcp
+c   **********************************
+       
+
+c-----------------------------------------------------------------------
+c    initialisation
+c    --------------
+
+      IF (firstcall) THEN
+
+        write(*,*) 'In dustdevil :'
+        write(*,*) '    q2top= ',q2top,'     seuil= ', seuil 
+c       un petit test de coherence:
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans coefdifv'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+
+c A rough estimation of the horizontal drag coefficient Cd
+c (the scale heigh is taken to be 13 km since we are typically
+c dealing with daytime temperature around 250K.
+c 
+         z1= -0.5*13.e3*log(pplev(1,2)/pplev(1,1))
+         Cd = (0.4/log(z1/z0))**2
+
+         firstcall=.false.
+
+c        Temporaire
+c        open(77,file='devil')
+      
+      ENDIF
+
+c-----------------------------------------------------------------------
+c Initialisation
+      do iq=1,nq
+       do l=1,nlay
+           do ig=1,ngrid
+             pdqdev(ig,l,iq)= 0
+           end do
+       end do
+      end do
+
+
+c-----------------------------------------------------------------------
+c      Determining the top of the boundary layer
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+         do  l=2,nlay-1
+            if (pq2(ig,l).lt.q2top)then
+              ltop(ig)=l
+              goto 99
+            end if
+         enddo
+ 99      continue
+
+c        ***************************************
+cc        if (ptsurf(ig).gt.255)then
+c         write(*,*) 'tsurf, ztop (km): ', ig,
+c     &   ptsurf(ig), -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c         if ((ptsurf(ig).gt.50.).and.(
+c     &      (-12.*log(pplev(ig,ltop(ig))/pplev(ig,1))).gt.60.))then
+c            do l=1,nlay
+c             write(*,*) l,
+c     &       -12.*log(pplev(ig,l)/pplev(ig,1)),pq2(ig,l)
+c            end do
+c         end if
+cc        end if
+c        ***************************************
+     
+      enddo
+
+c        ***************************************
+c        do ig=100,148
+c           write(*,*)'time,tsurf,ztop', localtime(ig),ptsurf(ig),
+c    &      -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c        end do
+c        ***************************************
+
+
+c   Calculation : dust devil intensity
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+
+c --------------------------------------------------
+c 1) Version 1 : sensible heat flux using actual wind :
+c        Wind magnitude:
+c        wind = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c
+c --------------------------------------------------
+c 2) Version 2 : sensible heat flux using  wind = 15 m/s
+         wind = 15.
+c ----------------------------------------------------
+c        Density :
+         rho=pplev(ig,1)/(R*pt(ig,1))
+
+c        Sensible heat flux (W.m-2) (>0 if up)
+         Fs= rho*cpp*Cd * wind
+     &       * (ptsurf(ig) -pt(ig,1))
+         b= (pplev(ig,1)**(rcp+1) - pplev(ig,ltop(ig))**(rcp+1)) /
+     &    ( (pplev(ig,1)-pplev(ig,ltop(ig)))*(rcp+1)*pplev(ig,1)**rcp)
+
+c        b_diag(ig) = b     ! TEMPORAIRE (pour diagnostique)
+
+c   Energy flux available to drive dust devil (W.m-2) : (1-b)*Fs
+c   Dust devil activity : 
+         devila(ig)= max( 0. , (1-b)*Fs - seuil ) 
+      enddo
+c   
+c     lifted dust (kg m-2 s-1)  (<0 when lifting)
+c     ~~~~~~~~~~  
+      do iq=1,nq
+         do ig=1,ngrid
+           pdqs_dev(ig,iq)= - alpha_devil(iq) * devila(ig)
+         end do
+      end do 
+
+c     Injection of dust in the atmosphere (up to the top of pbl)
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,nq
+       do ig=1,ngrid
+         if (devila(ig).ne.0.) then
+           do l=1,ltop(ig)
+             pdqdev(ig,l,iq)=-pdqs_dev(ig,iq)*g/
+     &        (pplev(ig,1)-pplev(ig,ltop(ig)))
+           end do
+         end if
+       end do
+      end do
+
+c *********************************************************     
+c     TEMPORAIRE AVEC ANLDEVIL:
+c     IF (ngrid.gt.1) THEN
+c      do ig=2,ngridmx-1
+c       write(77,88) lati(ig)*180./pi,localtime(ig),
+c    &        -12.*log(pplev(ig,ltop(ig))/pplev(ig,1)),
+c    &   devil(ig),min(sqrt(pu(ig,1)**2+pv(ig,1)**2),40.),
+c    &   ptsurf(ig)-pt(ig,1),ptsurf(ig),pplev(ig,1)
+c      end do    
+c88    format (f7.3,1x,f7.3,1x,f6.3,1x,f6.4,1x,f7.4,1x,
+c    &        f7.3,1x,f7.3,1x,f9.3)
+c      do ig=1,ngridmx
+c       ztop(ig) = -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c       magwind(ig) = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c       t1(ig) =max(ptsurf(ig)- pt(ig,1),0.)
+c      end do
+
+c       call WRITEDIAGFI(ngridmx,'dqs_dev','dqs devil',
+c    &               'kg.m-2.s-1',2,pdqs_dev)
+c       call WRITEDIAGFI(ngridmx,'wind','wind',
+c    &               'm.s-1',2,magwind)
+c       call WRITEDIAGFI(ngridmx,'ztop','top pbl',
+c    &               'km',2,ztop)
+c       call WRITEDIAGFI(ngridmx,'tsurf','tsurf',
+c    &               'K',2,ptsurf)
+c       call WRITEDIAGFI(ngridmx,'T1','T(1)',
+c    &               'K',2,t1)
+c       call WRITEDIAGFI(ngridmx,'b','b',
+c    &               ' ',2,b_diag)
+c     END If
+c *********************************************************     
+         
+      RETURN
+      END
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustlift.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustlift.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/dustlift.F	(revision 46)
@@ -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: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.F	(revision 46)
@@ -0,0 +1,59 @@
+      subroutine eofdump(ngrid,nlayer,u,v,t,rho,ps)
+
+      implicit none
+c
+c     Dumps profiles for calculation of variability EOFs 
+c     Modified to include rho, FF 09/2004
+c     Corrected small bug in sampling rate/count, EM 11/2007
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "eofdump.h"
+c
+
+      integer ngrid
+      integer nlayer
+      real*4 u(ngrid,nlayer)
+      real*4 v(ngrid,nlayer)
+      real*4 t(ngrid,nlayer)
+      real*4 rho(ngrid,nlayer)
+      real*4 ps(ngrid)
+      integer count
+      data count /0/
+      save count
+      integer i,j,l, ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c-------------------------------------------------------
+c     Initialization at first call:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (firstcall) THEN
+        write(*,*) 'CALL ineofdump'
+        CALL ineofdump
+        firstcall=.false.
+      END IF
+
+c-------------------------------------------------------
+c     Dumps every ieofs physics timesteps
+c
+!      write(*,*)'eofdump:count=',count,' ps(1)=',ps(1)
+!      if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then
+      if (mod(count+1,ieofs).eq.0) then
+!        write(*,*)'eofdump: dump --> ps(1)=',ps(1)
+        do i=1,iim,eofskip
+          do j=1+eofskip/2,jjm+1,eofskip
+            ig = 1+ (j-2)*iim +i
+            write(uedata) (u(ig,l),l=1,nlayer)
+            write(uedata) (v(ig,l),l=1,nlayer)
+            write(uedata) (t(ig,l),l=1,nlayer)
+            write(uedata) (rho(ig,l),l=1,nlayer)
+            write(uedata) ps(ig)
+          enddo
+        enddo
+      endif
+      count=count+1
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/eofdump.h	(revision 46)
@@ -0,0 +1,22 @@
+c
+c  eofdump:
+c	This include file controls the production of data for EOFs.
+c
+c	Dump profiles for EOFs every ieofs physics timesteps,
+c       starting at first call.
+	integer ieofs
+c
+c	Only dump profiles every eofskip points in each direction
+c       on the model grid.
+	integer eofskip
+	parameter (eofskip = 4)
+c
+c	Units for writing EOF header and data
+	integer uehead, uedata
+	parameter (uehead = 82, uedata = 83)
+c
+	common /eofcom/ ieofs
+c
+      INTEGER npgrid
+      PARAMETER(npgrid=ngridmx+2*(iim-1))
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/flusv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/flusv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/flusv.F	(revision 46)
@@ -0,0 +1,333 @@
+      SUBROUTINE flusv(KDLON,nsf,n,omega,g,tau,emis,bh,bsol,fah,fdh)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  calcul des flux ascendant et descendant aux interfaces entre n couches
+c  * dans l'infrarouge 
+c  * B est une fonction lineaire de $\tau$ a l'interieur de chaque couche
+c  * le B du sol peut etre different de celui qui correspond au profil
+c    de la n-ieme couche
+c  * l'hypothese est une hypothese a deux flux isotropes sur chaque 
+c    hemisphere ("hemispheric constant") + "source function technique"
+c    (voir Toon et al. 1988)
+c  * le flux descendant en haut de l'atmosphere est nul
+c  * les couches sont numerotees du haut de l'atmosphere vers le sol
+c
+c  in :   * KDLON      ---> dimension de vectorisation
+c         * nsf        ---> nsf=0 ==> "hemispheric constant"
+c                           nsf>0 ==> "hemispheric constant" + "source function"
+c         * n          ---> nombre de couches
+c         * omega(i)   ---> single scattering albedo pour la i-eme couche
+c         * g(i)       ---> asymmetry parameter pour la i-eme couche
+c         * tau(i)     ---> epaisseur optique de la i-eme couche
+c         * emis       ---> emissivite du sol
+c         * bh(i)      ---> luminance du corps noir en haut de la i-eme
+c                           couche, bh(n+1) pour la valeur au sol qui
+c                           correspond au profil de la n-ieme couche
+c         * bsol       ---> luminance du corps noir au sol
+c
+c  out :  * fah(i)     ---> flux ascendant en haut de la i-eme couche,
+c                           fah(n+1) pour le sol 
+c         * fdh(i)     ---> flux descendant en haut de la i-eme couche,
+c                           fdh(n+1) pour le sol 
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,nsf,n
+      REAL omega(NDLO2,n),g(NDLO2,n),tau(NDLO2,n),emis(NDLO2)
+     &,bh(NDLO2,n+1),bsol(NDLO2),fah(NDLO2,n+1),fdh(NDLO2,n+1)
+c.......................................................................
+c  declaration des variables locales
+c 
+      REAL pi
+      PARAMETER (pi=3.141592653589793E+0)
+      INTEGER iv,i,j
+      REAL beta,gama1,gama2,amu1,grgama,b0,b1
+      REAL a(NDLON,4*nlayermx),b(NDLON,4*nlayermx)
+     &    ,d(NDLON,4*nlayermx),e(NDLON,4*nlayermx)
+     &    ,y(NDLON,4*nlayermx)
+     &    ,alambda(NDLON,2*nlayermx)
+     &    ,e1(NDLON,2*nlayermx),e2(NDLON,2*nlayermx)
+     &    ,e3(NDLON,2*nlayermx),e4(NDLON,2*nlayermx)
+     &    ,cah(NDLON,2*nlayermx),cab(NDLON,2*nlayermx)
+     &    ,cdh(NDLON,2*nlayermx),cdb(NDLON,2*nlayermx)
+      REAL grg(NDLON,2*nlayermx),grh(NDLON,2*nlayermx)
+     &    ,grj(NDLON,2*nlayermx),grk(NDLON,2*nlayermx)
+     &    ,alpha1(NDLON,2*nlayermx),alpha2(NDLON,2*nlayermx)
+     &    ,sigma1(NDLON,2*nlayermx),sigma2(NDLON,2*nlayermx)
+      INTEGER nq
+      PARAMETER (nq=8)
+      REAL x(nq),w(nq),gri(NDLON,nq)
+      DATA x/1.9855071751231860E-2 , 0.1016667612931866E+0
+     &     , 0.2372337950418355E+0 , 0.4082826787521751E+0
+     &     , 0.5917173212478250E+0 , 0.7627662049581645E+0
+     &     , 0.8983332387068134E+0 , 0.9801449282487682E+0/
+      DATA w/5.0614268145185310E-2 , 0.1111905172266872E+0
+     &     , 0.1568533229389437E+0 , 0.1813418916891810E+0
+     &     , 0.1813418916891810E+0 , 0.1568533229389437E+0
+     &     , 0.1111905172266872E+0 , 5.0614268145185310E-2/
+c....................................................................... 
+c
+c....................................................................... 
+      do 10001 i=1,n
+                                                   do 99999 iv=1,KDLON
+      beta=(1.E+0-g(iv,i))/2.E+0
+      gama1=2.E+0*(1.E+0-omega(iv,i)*(1.E+0-beta))
+      gama2=2.E+0*omega(iv,i)*beta
+      amu1=5.E-1
+      alambda(iv,i)=sqrt(gama1**2-gama2**2)
+      grgama=(gama1-alambda(iv,i))/gama2
+c
+c ici une petite bidouille : si l'epaisseur optique d'une couche
+c est trop faible, $dB \over d\tau$ devient tres grand et le schema
+c s'ecroule. dans ces cas, on fait l'hypothese de couche isotherme.
+c
+      if (tau(iv,i).gt.1.E-3) then
+      b0=bh(iv,i)
+      b1=(bh(iv,i+1)-b0)/tau(iv,i)
+      else
+      b0=(bh(iv,i)+bh(iv,i+1))/2.E+0
+      b1=0.E+0
+      endif
+c
+      e1(iv,i)=1.E+0+grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e2(iv,i)=1.E+0-grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e3(iv,i)=grgama+exp(-alambda(iv,i)*tau(iv,i))
+      e4(iv,i)=grgama-exp(-alambda(iv,i)*tau(iv,i))
+      cah(iv,i)=2.E+0*pi*amu1*(b0+b1/(gama1+gama2))
+      cab(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)+1.E+0/(gama1+gama2)))
+      cdh(iv,i)=2.E+0*pi*amu1*(b0-b1/(gama1+gama2))
+      cdb(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)-1.E+0/(gama1+gama2)))  
+c
+      grg(iv,i)=(1.E+0/amu1-alambda(iv,i))
+      grh(iv,i)=grgama*(alambda(iv,i)+1.E+0/amu1)
+      grj(iv,i)=grh(iv,i)
+      grk(iv,i)=grg(iv,i)
+      alpha1(iv,i)=2.E+0*pi*(b0+b1*(1.E+0/(gama1+gama2)-amu1))
+      alpha2(iv,i)=2.E+0*pi*b1
+      sigma1(iv,i)=2.E+0*pi*(b0-b1*(1.E+0/(gama1+gama2)-amu1))
+      sigma2(iv,i)=alpha2(iv,i)
+c
+99999                                              continue
+10001 continue
+c.......................................................................
+                                                   do 99998 iv=1,KDLON
+      a(iv,1)=0.E+0
+      b(iv,1)=e1(iv,1)
+      d(iv,1)=-e2(iv,1)
+      e(iv,1)=-cdh(iv,1)
+99998                                              continue
+c
+      do 10002 i=1,n-1 
+      j=2*i+1
+                                                   do 99997 iv=1,KDLON
+      a(iv,j)=e2(iv,i)*e3(iv,i)-e4(iv,i)*e1(iv,i)
+      b(iv,j)=e1(iv,i)*e1(iv,i+1)-e3(iv,i)*e3(iv,i+1)
+      d(iv,j)=e3(iv,i)*e4(iv,i+1)-e1(iv,i)*e2(iv,i+1)
+      e(iv,j)=e3(iv,i)*(cah(iv,i+1)-cab(iv,i))
+     &       +e1(iv,i)*(cdb(iv,i)-cdh(iv,i+1))
+99997                                              continue
+10002 continue
+c
+      do 10003 i=1,n-1
+      j=2*i
+                                                   do 99996 iv=1,KDLON
+      a(iv,j)=e2(iv,i+1)*e1(iv,i)-e3(iv,i)*e4(iv,i+1)
+      b(iv,j)=e2(iv,i)*e2(iv,i+1)-e4(iv,i)*e4(iv,i+1)
+      d(iv,j)=e1(iv,i+1)*e4(iv,i+1)-e2(iv,i+1)*e3(iv,i+1)
+      e(iv,j)=e2(iv,i+1)*(cah(iv,i+1)-cab(iv,i))
+     &       +e4(iv,i+1)*(cdb(iv,i)-cdh(iv,i+1))
+99996                                              continue
+10003 continue
+c     
+      j=2*n
+                                                   do 99995 iv=1,KDLON
+      a(iv,j)=e1(iv,n)-(1.E+0-emis(iv))*e3(iv,n)
+      b(iv,j)=e2(iv,n)-(1.E+0-emis(iv))*e4(iv,n)
+      d(iv,j)=0.E+0
+      e(iv,j)=emis(iv)*pi*bsol(iv)-cab(iv,n)+(1.E+0-emis(iv))*cdb(iv,n)
+99995                                              continue
+c.......................................................................
+      call sys3v(KDLON,2*n,a,b,d,e,y)
+c....................................................................... 
+      do 10004 i=1,n
+                                                   do 99994 iv=1,KDLON
+      grg(iv,i)=grg(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grh(iv,i)=grh(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+      grj(iv,i)=grj(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grk(iv,i)=grk(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+99994                                              continue
+10004 continue
+c.......................................................................
+c les valeurs de flux "hemispheric constant"
+c 
+      IF (nsf.eq.0) THEN
+      do 10005 i=1,n
+                                                   do 99993 iv=1,KDLON
+      fah(iv,i)=e3(iv,i)*y(iv,2*i-1)-e4(iv,i)*y(iv,2*i)+cah(iv,i)
+      fdh(iv,i)=e1(iv,i)*y(iv,2*i-1)-e2(iv,i)*y(iv,2*i)+cdh(iv,i)
+99993                                              continue
+10005 continue
+                                                   do 99992 iv=1,KDLON
+      fah(iv,n+1)=e1(iv,n)*y(iv,2*n-1)+e2(iv,n)*y(iv,2*n)+cab(iv,n)
+      fdh(iv,n+1)=e3(iv,n)*y(iv,2*n-1)+e4(iv,n)*y(iv,2*n)+cdb(iv,n)
+99992                                              continue
+      GOTO 10100
+      ENDIF 
+c....................................................................... 
+c passage a "source function" 
+c 
+c on applique une quadrature de dimension nq
+c x est le vecteur des \mu de la quadrature
+c w est le vecteur des poids correspondants
+c nq est fixe en parameter
+c x et w sont fixes en data
+c 
+c....................................................................... 
+c on part d'en haut et on descent selon les nq angles pour calculer
+c tous les flux descendants 
+c
+      do 10006 j=1,nq 
+                                                   do 99991 iv=1,KDLON
+      gri(iv,j)=0.E+0
+99991                                              continue
+10006 continue
+                                                   do 99990 iv=1,KDLON
+      fdh(iv,1)=0.E+0
+99990                                              continue
+      do 10007 i=1,n
+      do 10008 j=1,nq
+                                                   do 99989 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grj(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+grk(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+sigma1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+sigma2(iv,i)*(x(j)*exp(-tau(iv,i)/x(j))+tau(iv,i)-x(j))
+99989                                              continue
+10008 continue
+                                                   do 99988 iv=1,KDLON
+      fdh(iv,i+1)=0.E+0
+99988                                              continue
+      do 10009 j=1,nq 
+                                                   do 99987 iv=1,KDLON
+      fdh(iv,i+1)=fdh(iv,i+1)+w(j)*x(j)*gri(iv,j)
+99987                                              continue
+10009 continue
+10007 continue
+c.......................................................................
+c on applique la condition de reflexion a sol 
+c
+                                                   do 99986 iv=1,KDLON
+      fah(iv,n+1)=(1.E+0-emis(iv))*fdh(iv,n+1)+pi*emis(iv)*bsol(iv)
+99986                                              continue
+      do 10010 j=1,nq
+                                                   do 99985 iv=1,KDLON
+      gri(iv,j)=2.E+0*fah(iv,n+1)
+99985                                              continue
+10010 continue 
+c.......................................................................
+c on remonte pour calculer tous les flux ascendants 
+c  
+      do 10011 i=n,1,-1 
+      do 10012 j=1,nq 
+                                                   do 99984 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grg(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+grh(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+alpha1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+alpha2(iv,i)*(x(j)-(tau(iv,i)+x(j))*exp(-tau(iv,i)/x(j)))
+99984                                              continue
+10012 continue
+                                                   do 99983 iv=1,KDLON
+      fah(iv,i)=0.E+0
+99983                                              continue
+      do 10013 j=1,nq 
+                                                   do 99982 iv=1,KDLON
+      fah(iv,i)=fah(iv,i)+w(j)*x(j)*gri(iv,j)
+99982                                              continue
+10013 continue
+10011 continue
+c.......................................................................
+10100 continue      
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END
+
+c ***************************************************************
+
+
+      SUBROUTINE sys3v(KDLON,n,a,b,d,e,y)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  inversion d'un systeme lineaire tridiagonal
+c
+c  |  b1  d1               |   | y1 |   | e1 |
+c  |  a2  b2  d2           |   | y2 |   | e2 |
+c  |      a3  b3  d3       | * | y3 | = | e3 |
+c  |             ....      |   |    |   |    |
+c  |              an  bn   |   | yn |   | en |
+c
+c  in :   * KDLON        --> dimension de vectorisation
+c         * n            --> dimension du systeme
+c         * a,b,d,e      --> voir dessin
+c
+c  out :  * y            --> voir dessin
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,n
+      REAL a(NDLO2,n),b(NDLO2,n),d(NDLO2,n),e(NDLO2,n),y(NDLO2,n)
+c.......................................................................
+c  declaration des variables locales
+c 
+      INTEGER iv,i
+      REAL as(NDLON,4*nlayermx),ds(NDLON,4*nlayermx)
+     &    ,x(NDLON,4*nlayermx)
+c.......................................................................
+c
+c.......................................................................
+                                                   do 99999 iv=1,KDLON
+      as(iv,n)=a(iv,n)/b(iv,n)
+      ds(iv,n)=e(iv,n)/b(iv,n)
+99999                                              continue
+      do 10001 i=n-1,1,-1
+                                                   do 99998 iv=1,KDLON
+      x(iv,i)=1.E+0/(b(iv,i)-d(iv,i)*as(iv,i+1))
+      as(iv,i)=a(iv,i)*x(iv,i)
+      ds(iv,i)=(e(iv,i)-d(iv,i)*ds(iv,i+1))*x(iv,i)
+99998                                              continue
+10001 continue 
+                                                   do 99997 iv=1,KDLON
+      y(iv,1)=ds(iv,1)
+99997                                              continue
+      do 10002 i=2,n 
+                                                   do 99996 iv=1,KDLON
+      y(iv,i)=ds(iv,i)-as(iv,i)*y(iv,i-1)
+99996                                              continue
+10002 continue
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/gr_fi_dyn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/gr_fi_dyn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/gr_fi_dyn.F	(revision 46)
@@ -0,0 +1,38 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/growthrate.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/growthrate.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/growthrate.F	(revision 46)
@@ -0,0 +1,107 @@
+      subroutine growthrate(timestep,t,p,ph2o,psat,seq,r,Cste)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c     Determination of the water ice crystal growth rate
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c
+c   arguments:
+c   ----------
+
+      REAL timestep
+      REAL t    ! temperature in the middle of the layer (K)
+      REAL p    ! pressure in the middle of the layer (K)
+      REAL*8 ph2o ! water vapor partial pressure (Pa)
+      REAL*8 psat ! water vapor saturation pressure (Pa) 
+      REAL r    ! crystal radius before condensation (m)
+      REAL seq  ! Equilibrium saturation ratio
+      REAL dr   ! crystal radius variation (m)
+
+c   local:
+c   ------
+
+      REAL molco2,molh2o
+      REAL Mco2,Mh2o,rho_i,sigh2o
+      REAL nav,rgp,kbz,pi,To
+
+c     Effective gas molecular radius (m)
+      data molco2/2.2e-10/   ! CO2
+c     Effective gas molecular radius (m)
+      data molh2o/1.2e-10/   ! H2O
+c     Molecular weight of CO2
+      data Mco2/44.e-3/            ! kg.mol-1
+c     Molecular weight of H2O
+      data Mh2o/18.e-3/            ! kg.mol-1
+c     surface tension of ice/vapor
+      data sigh2o/0.12/	     ! N.m
+c     Ice density
+      data rho_i/917./        ! kg.m-3 also defined in initcld.f
+c     Avogadro number
+      data nav/6.023e23/
+c     Perfect gas constant
+      data rgp/8.3143/
+c     Boltzman constant
+      data kbz/1.381e-23/
+c     pi number
+      data pi/3.141592654/
+c     Reference temperature, T=273,15 K 
+      data To/273.15/
+
+      REAL k,Lv                 
+      REAL knudsen           ! Knudsen number (gas mean free path/particle radius)
+      REAL a,Dv,lambda       ! Intermediate computations for growth rate
+      REAL*8 Rk,Rd
+      REAL Cste, rf
+
+c-----------------------------------------------------------------------
+c      Ice particle growth rate by diffusion/impegement of water molecules
+c                r.dr/dt = (S-Seq) / (Seq*Rk+Rd)
+c        with r the crystal radius, Rk and Rd the resistances due to 
+c        latent heat release and to vapor diffusion respectively 
+c----------------------------------------------------------------------- 
+
+c     - Equilibrium saturation accounting for KeLvin Effect
+       seq=exp(2*sigh2o*Mh2o/(rho_i*rgp*t*r))
+
+c     - Thermal conductibility of CO2
+      k  = (0.17913 * t - 13.9789) * 4.184e-4
+c     - Latent heat of h2o (J.kg-1)
+      Lv = (2834.3 - 0.28 * (t-To) - 0.004 * (t-To)**2 ) * 1.e+3
+
+c     - Constant to compute gas mean free path
+c     l= (T/P)*a, with a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+      a = 0.707*rgp/(4 * pi* molco2**2  * nav)
+
+c     - Compute Dv, water vapor diffusion coefficient
+c       accounting for both kinetic and continuum regime of diffusion,
+c       the nature of which depending on the Knudsen number.
+
+      Dv = 1./3. * sqrt( 8*kbz*t/(pi*Mh2o/nav) )* kbz * t / 
+     &   ( pi * p * (molco2+molh2o)**2 * sqrt(1.+Mh2o/Mco2) )
+
+      knudsen = t / p * a / r
+      lambda  = (1.333+0.71/knudsen) / (1.+1./knudsen)
+      Dv      = Dv / (1. + lambda * knudsen)
+
+c     - Compute Rk
+      Rk = Lv**2 * rho_i * Mh2o / (k*rgp*t**2.)
+c     - Compute Rd
+      Rd = rgp * t *rho_i / (Dv*psat*Mh2o)
+
+c     - Compute Cste=rdr/dt, then r(t+1)= sqrt(r(t)**2.+2.*Cste*dt)
+       Cste = 1. / (seq*Rk+Rd)
+c      Cste = (ph2o/psat-seq) / (seq*Rk+Rd)
+c      rf   = sqrt( max( r**2.+2.*Cste*timestep , 0. ) )
+c      dr   = rf-r
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ineofdump.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ineofdump.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ineofdump.F	(revision 46)
@@ -0,0 +1,71 @@
+      subroutine ineofdump
+
+c._.  subroutine ineofdump(long, lati)
+
+      implicit none
+c
+c     Initialise dumping of profiles for EOF calculations
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comvert.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+c
+c._.#include "param2"
+c._.#include "bats"
+c._.#include "outcon"
+c._.#include "phycmn"
+c
+#include "eofdump.h"
+c
+c._.      real*4 long(cols,rows)
+c._.      real*4 lati(cols,rows)
+      integer ig,i,j,l    
+      logical firstcall
+      save firstcall
+
+      data firstcall/.true./
+
+      if (firstcall) then
+         firstcall=.false.
+      endif
+
+c
+c     Set frequency for dumping at once per day
+c
+      ieofs=nint(daysec/dtphys)
+      if (abs(float(ieofs)-daysec/dtphys).gt.1.e-8*daysec)
+     :   stop'In ineofdump:  1 day .ne. n physics timesteps'
+c
+c     Header
+c
+      open(uehead,file='profiles.hdr',form='formatted')
+c._.  write(uehead,*) rntape, kstart, ktotal, itspd, kphysic, refday
+      write(uehead,*) 0.E+0,0,0,ieofs,1,0
+c._.  write(uehead,*) cols, rows, npgrid, nl
+      write(uehead,*) iim,npgrid/iim,npgrid,nlayermx
+
+c._.  do i=1,cols,eofskip
+c._.    do j=1+eofskip/2,rows,eofskip
+c._.      write(uehead,*) long(i,j)*180./pi, lati(i,j)*180./pi
+c._.    enddo
+c._.  enddo
+      do i=1,iim,eofskip
+        do j=1+eofskip/2,jjm+1,eofskip    
+          ig = 1+ (j-2)*iim +i
+          if(j.eq.1) stop 'Problem in ineofdump.F'
+          if(j.eq.jjm+1) stop 'Problem in ineofdump.F'
+          write(uehead,*) long(ig)*180./pi, lati(ig)*180./pi
+c         write(*,*) 'eof grid j=',j,' lat= ', lati(ig)*180./pi
+        enddo
+      enddo
+
+      write(uehead,*) aps
+      write(uehead,*) bps
+      close(uehead)
+c
+c     Main profile file
+c
+      open(uedata,file='profiles.dat',form='unformatted')
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniorbit.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniorbit.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniorbit.F	(revision 46)
@@ -0,0 +1,102 @@
+      SUBROUTINE iniorbit
+     $     (paphelie,pperiheli,pyear_day,pperi_day,pobliq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:
+c   -------
+c     Frederic Hourdin      22 Fevrier 1991
+c
+c   Objet:
+c   ------
+c    Initialisation du sous programme orbite qui calcule
+c    a une date donnee de l'annee de duree year_day commencant
+c    a l'equinoxe de printemps et dont le perihelie se situe
+c    a la date peri_day, la distance au soleil et la declinaison.
+c
+c   Interface:
+c   ----------
+c   - Doit etre appele avant d'utiliser orbite.
+c   - initialise une partie du common planete.h
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   aphelie       \   aphelie et perihelie de l'orbite
+c   periheli      /   en millions de kilometres.
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c   Arguments:
+c   ----------
+
+      REAL paphelie,pperiheli,pyear_day,pperi_day,pobliq
+
+c   Local:
+c   ------
+
+      REAL zxref,zanom,zz,zx0,zdx
+      INTEGER iter
+
+c-----------------------------------------------------------------------
+
+      pi=2.*asin(1.)
+
+      aphelie =paphelie
+      periheli=pperiheli
+      year_day=pyear_day
+      obliquit=pobliq
+      peri_day=pperi_day
+
+      PRINT*,'Perihelie en Mkm  ',periheli
+      PRINT*,'Aphelise  en Mkm  ',aphelie 
+      PRINT*,'obliquite en degres  :',obliquit
+      unitastr=149.597927
+      e_elips=(aphelie-periheli)/(periheli+aphelie)
+      p_elips=0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
+
+      print*,'e_elips',e_elips
+      print*,'p_elips',p_elips
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(year_day-pperi_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      zxref=abs(zanom)
+      PRINT*,'zanom  ',zanom
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
+c  methode de Newton
+
+      zx0=zxref+e_elips*sin(zxref)
+      DO 110 iter=1,100
+         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-12)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+      PRINT*,'zx0   ',zx0
+
+c zteta est la longitude solaire
+
+      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+      PRINT*,'longitude solaire du perihelie timeperi = ',timeperi
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/inistats.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/inistats.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/inistats.F	(revision 46)
@@ -0,0 +1,112 @@
+      subroutine inistats(ierr)
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+      integer,intent(out) :: ierr
+      integer :: nid
+      integer :: l,nsteppd
+      real, dimension(llm) ::  sig_s
+      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
+      real, dimension(istime) :: lt
+      integer :: nvarid
+
+      write (*,*) 
+      write (*,*) '                        || STATS ||'
+      write (*,*) 
+      write (*,*) 'daysec',daysec
+      write (*,*) 'dtphys',dtphys
+      nsteppd=nint(daysec/dtphys)
+      write (*,*) 'nsteppd=',nsteppd
+      if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+     ,   stop'Dans Instat:  1jour .ne. n pas physiques'
+
+      if(mod(nsteppd,istime).ne.0)
+     ,   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+
+      istats=nsteppd/istime
+      write (*,*) 'istats=',istats
+      write (*,*) 'Storing ',istime,'times per day'
+      write (*,*) 'thus every ',istats,'physical timestep '
+      write (*,*) 
+
+      do l= 1, llm
+         sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+         pseudoalt(l)=-10.*log(presnivs(l)/preff)   
+      enddo
+
+      ierr = NF_CREATE("stats.nc",NF_CLOBBER,nid)
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_lat)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_lon)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid, "llmp1", llm+1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+
+      ierr = NF_ENDDEF(nid)
+      call def_var(nid,"Time","Time",
+     .            "days since 0000-00-0 00:00:00",1,
+     .            idim_time,nvarid,ierr)
+! Time is initialised later by mkstats subroutine
+
+      call def_var(nid,"latitude","latitude","degrees_north",1,
+     .            idim_lat,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+      call def_var(nid,"longitude","East longitude","degrees_east",1,
+     .            idim_lon,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+
+! Niveaux verticaux, aps et bps
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"altitude", NF_DOUBLE, 1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"altitude", NF_FLOAT, 1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",8,"altitude")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif 
+      call def_var(nid,"aps","hybrid pressure at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else 
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      ierr=NF_CLOSE(nid)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/initracer.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/initracer.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/initracer.F	(revision 46)
@@ -0,0 +1,514 @@
+      SUBROUTINE initracer(qsurf,co2ice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialization related to tracer 
+c   (transported dust, water, chemical species, ice...)
+c
+c   Name of the tracer
+c
+c   Test of dimension :
+c   Initialize COMMON tracer in tracer.h, using tracer names provided
+c   by the dynamics in "advtrac.h"
+c
+c   Old conventions: (not used any more)
+c
+c   If water=T : q(iq=nqmx) is the water mass mixing ratio
+c     and q(iq=nqmx-1) is the ice mass mixing ratio
+
+c   If there is transported dust, it uses iq=1 to iq=dustbin
+c   If there is no transported dust : dustbin=0
+c   If doubleq=T : q(iq=1) is the dust mass mixing ratio
+c                  q(iq=2) is the dust number mixing ratio 
+
+c   If (photochem.or.thermochem) there is "ncomp" chemical species (ncomp
+c   is set in aeronomars/chimiedata.h) using the ncomp iq values starting at
+c      iq=nqchem_min = dustbin+1   (nqchem_min is defined in inifis.F)
+c   
+c
+c   author: F.Forget
+c   ------
+c    Modifs: Franck Montmessin, Sebastien Lebonnois (june 2003)
+c            Ehouarn Millour (oct. 2008) identify tracers by their names
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "advtrac.h"
+#include "comgeomfi.h"
+#include "watercap.h"
+#include "chimiedata.h"  
+
+      real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+      real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+      integer iq,ig,count
+      real r0_lift , reff_lift
+      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+      character(len=20) :: txt ! to store some text
+
+c-----------------------------------------------------------------------
+c  radius(nqmx)      ! aerosol particle radius (m)
+c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+c  qext(nqmx)        ! Single Scat. Extinction coeff at 0.67 um
+c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+c  rho_dust          ! Mars dust density
+c  rho_ice           ! Water ice density
+c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+c  varian            ! Characteristic variance of log-normal distribution
+c-----------------------------------------------------------------------
+
+      integer :: nqchem_start
+
+! Initialization: get tracer names from the dynamics and check if we are
+!                 using 'old' tracer convention ('q01',q02',...)
+!                 or new convention (full tracer names)
+      ! check if tracers have 'old' names
+      oldnames=.false.
+      count=0
+      do iq=1,nqmx
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tnom(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+      
+      if (count.eq.nqmx) then
+        write(*,*) "initracer: tracers seem to follow old naming ",
+     &             "convention (q01,q02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldnames=.true.
+      endif
+
+      ! copy/set tracer names
+      if (oldnames) then ! old names (derived from iq & option values)
+        ! 1. dust:
+        if (dustbin.ne.0) then ! transported dust
+          do iq=1,dustbin
+            txt=" "
+            write(txt,'(a4,i2.2)') 'dust',iq
+            noms(iq)=txt
+            mmol(iq)=100.
+          enddo
+          ! special case if doubleq
+          if (doubleq) then
+            if (dustbin.ne.2) then
+              write(*,*) 'initracer: error expected dustbin=2'
+            else
+              noms(1)='dust_mass'   ! dust mass mixing ratio
+              noms(2)='dust_number' ! dust number mixing ratio
+            endif
+          endif
+        endif
+        ! 2. water & ice
+        if (water) then
+          noms(nqmx)='h2o_vap'
+          mmol(nqmx)=18.
+          noms(nqmx-1)='h2o_ice'
+          mmol(nqmx-1)=18.
+        endif
+        ! 3. Chemistry
+        if (photochem .or. callthermos) then
+          if (doubleq) then
+            nqchem_start=3
+          else
+            nqchem_start=dustbin+1
+          end if
+          do iq=nqchem_start,nqchem_start+ncomp-1
+            noms(iq)=nomchem(iq-nqchem_start+1)
+            mmol(iq)=mmolchem(iq-nqchem_start+1)
+          enddo
+        endif ! of if (photochem .or. callthermos)
+        ! 4. Other tracers ????
+        if ((dustbin.eq.0).and.(.not.water)) then
+          noms(1)='co2'
+          mmol(1)=44
+          if (nqmx.eq.2) then
+            noms(nqmx)='Ar_N2'
+            mmol(nqmx)=30
+          endif
+        endif
+      else
+        ! copy tracer names from dynamics
+        do iq=1,nqmx
+          noms(iq)=tnom(iq)
+        enddo
+        ! mmol(:) array is initialized later (see below)
+      endif ! of if (oldnames)
+
+      ! special modification when using 'old' tracers:
+      ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
+      ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
+      if (oldnames.and.water) then
+        write(*,*)'initracer: moving surface water ice to index ',nqmx-1
+        qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx)
+        qsurf(1:ngridmx,nqmx)=0
+      endif 
+      
+c------------------------------------------------------------
+c     Test Dimensions tracers
+c------------------------------------------------------------
+
+      if(photochem.or.thermochem) then
+          if (water) then
+              if ((dustbin+ncomp+2).ne.nqmx) then
+                 print*,'initracer: tracer dimension problem:'
+                 print*,"(dustbin+ncomp+2).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"dustbin: ",dustbin
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+               endif
+          else
+              if ((dustbin+ncomp+1).ne.nqmx) then
+                 print*,'initracer: tracer dimension problem:'
+                 print*,"(dustbin+ncomp+1).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"dustbin: ",dustbin
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+                 STOP
+               endif
+            endif
+      endif
+
+c------------------------------------------------------------
+c         NAME and molar mass of the tracer 
+c------------------------------------------------------------
+
+   
+! Identify tracers by their names: (and set corresponding values of mmol)
+      ! 0. initialize tracer indexes to zero:
+      do iq=1,nqmx
+        igcm_dustbin(iq)=0
+      enddo
+      igcm_dust_mass=0
+      igcm_dust_number=0
+      igcm_h2o_vap=0
+      igcm_h2o_ice=0
+      igcm_co2=0
+      igcm_co=0
+      igcm_o=0
+      igcm_o1d=0
+      igcm_o2=0
+      igcm_o3=0
+      igcm_h=0
+      igcm_h2=0
+      igcm_oh=0
+      igcm_ho2=0
+      igcm_h2o2=0
+      igcm_n2=0
+      igcm_ar=0
+      igcm_ar_n2=0
+
+      ! 1. find dust tracers
+      count=0
+      if (dustbin.gt.0) then
+        do iq=1,nqmx
+          txt=" "
+          write(txt,'(a4,i2.2)')'dust',count+1
+          if (noms(iq).eq.txt) then
+            count=count+1
+            igcm_dustbin(count)=iq
+            mmol(iq)=100.
+          endif
+        enddo !do iq=1,nqmx
+      endif ! of if (dustbin.gt.0)
+      if (doubleq) then
+        do iq=1,nqmx
+          if (noms(iq).eq."dust_mass") then
+            igcm_dust_mass=iq
+            count=count+1
+          endif
+          if (noms(iq).eq."dust_number") then
+            igcm_dust_number=iq
+            count=count+1
+          endif
+        enddo
+      endif ! of if (doubleq)
+      ! 2. find chemistry and water tracers
+      do iq=1,nqmx
+        if (noms(iq).eq."co2") then
+          igcm_co2=iq
+          mmol(igcm_co2)=44.
+          count=count+1
+        endif
+        if (noms(iq).eq."co") then
+          igcm_co=iq
+          mmol(igcm_co)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."o") then
+          igcm_o=iq
+          mmol(igcm_o)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o1d") then
+          igcm_o1d=iq
+          mmol(igcm_o1d)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o2") then
+          igcm_o2=iq
+          mmol(igcm_o2)=32.
+          count=count+1
+        endif
+        if (noms(iq).eq."o3") then
+          igcm_o3=iq
+          mmol(igcm_o3)=48.
+          count=count+1
+        endif
+        if (noms(iq).eq."h") then
+          igcm_h=iq
+          mmol(igcm_h)=1.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2") then
+          igcm_h2=iq
+          mmol(igcm_h2)=2.
+          count=count+1
+        endif
+        if (noms(iq).eq."oh") then
+          igcm_oh=iq
+          mmol(igcm_oh)=17.
+          count=count+1
+        endif
+        if (noms(iq).eq."ho2") then
+          igcm_ho2=iq
+          mmol(igcm_ho2)=33.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o2") then
+          igcm_h2o2=iq
+          mmol(igcm_h2o2)=34.
+          count=count+1
+        endif
+        if (noms(iq).eq."n2") then
+          igcm_n2=iq
+          mmol(igcm_n2)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."ar") then
+          igcm_ar=iq
+          mmol(igcm_ar)=40.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_vap") then
+          igcm_h2o_vap=iq
+          mmol(igcm_h2o_vap)=18.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_ice") then
+          igcm_h2o_ice=iq
+          mmol(igcm_h2o_ice)=18.
+          count=count+1
+        endif
+        ! Other stuff: e.g. for simulations using co2 + neutral gaz
+        if (noms(iq).eq."Ar_N2") then
+          igcm_ar_n2=iq
+          mmol(igcm_ar_n2)=30.
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+!      count=count+nbqchem
+      
+      ! check that we identified all tracers:
+      if (count.ne.nqmx) then
+        write(*,*) "initracer: found only ",count," tracers"
+        write(*,*) "               expected ",nqmx
+        do iq=1,count
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+        stop
+      else
+        write(*,*) "initracer: found all expected tracers, namely:"
+        do iq=1,nqmx
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+      endif
+
+      ! if water cycle but iceparty=.false., there will nevertheless be
+      ! water ice at the surface (iceparty is not used anymore, but this
+      ! part is still relevant, as we want to stay compatible with the
+      ! older versions).
+      if (water.and.(igcm_h2o_ice.eq.0)) then
+        igcm_h2o_ice=igcm_h2o_vap ! so that qsurf(i_h2o_ice) is identified
+                                  ! even though there is no q(i_h2o_ice)
+      else
+       ! surface ice qsurf(i_h2o_ice) was loaded twice by phyetat0,
+       ! as qsurf(i_h2o_vap) & as qsurf(i_h2o_ice), so to be clean:
+       if (igcm_h2o_vap.ne.0) then
+         qsurf(1:ngridmx,igcm_h2o_vap)=0
+       endif
+      endif
+
+c------------------------------------------------------------
+c     Initialisation tracers ....
+c------------------------------------------------------------
+      call zerophys(nqmx,rho_q)
+
+      rho_dust=2500.  ! Mars dust density (kg.m-3)
+      rho_ice=920.    ! Water ice density (kg.m-3)
+
+      if (doubleq) then
+c       "doubleq" technique 
+c       -------------------
+c      (transport of mass and number mixing ratio)
+c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+
+        if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+          write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+          write(*,*)'water= ',water,' doubleq= ',doubleq   
+        end if
+
+        varian=0.637    ! Characteristic variance    
+        qext(igcm_dust_mass)=3.04   ! reference extinction at 0.67 um for ref dust
+        qext(igcm_dust_number)=3.04 ! reference extinction at 0.67 um for ref dust
+        rho_q(igcm_dust_mass)=rho_dust
+        rho_q(igcm_dust_number)=rho_dust
+
+c       Intermediate calcul for computing geometric mean radius r0
+c       as a function of mass and number mixing ratio Q and N
+c       (r0 = (r3n_q * Q/ N)
+        r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+
+c       Intermediate calcul for computing effective radius reff
+c       from geometric mean radius r0
+c       (reff = ref_r0 * r0)
+        ref_r0 = exp(2.5*varian**2)
+        
+c       lifted dust :
+c       '''''''''''
+        reff_lift = 3.e-6      !  Effective radius of lifted dust (m)
+        alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+        alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+
+        r0_lift = reff_lift/ref_r0
+        alpha_devil(igcm_dust_number)=r3n_q*
+     &                        alpha_devil(igcm_dust_mass)/r0_lift**3
+        alpha_lift(igcm_dust_number)=r3n_q*
+     &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+
+c       Not used:
+        radius(igcm_dust_mass) = 0.
+        radius(igcm_dust_number) = 0.
+
+      else
+
+       if (dustbin.gt.1) then
+        print*,'ATTENTION:',
+     $   ' properties of dust need input in initracer !!!'
+        stop
+
+       else if (dustbin.eq.1) then
+
+c       This will be used for 1 dust particle size:
+c       ------------------------------------------
+        radius(igcm_dustbin(1))=3.e-6
+        Qext(igcm_dustbin(1))=3.04
+        alpha_lift(igcm_dustbin(1))=0.0e-6
+        alpha_devil(igcm_dustbin(1))=7.65e-9
+        qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+     &                         /(rho_dust*radius(igcm_dustbin(1)))
+        rho_q(igcm_dustbin(1))=rho_dust
+
+       endif
+      end if    ! (doubleq)
+
+c     Initialization for photochemistry:
+c     ---------------------------------
+      if (photochem) then
+      ! initialize chemistry+water (water will be correctly initialized below)
+      ! by initializing everything which is not dust ...
+        do iq=1,nqmx
+          txt=noms(iq)
+          if (txt(1:4).ne."dust") then
+            radius(iq)=0.
+            Qext(iq)=0.
+            alpha_lift(iq) =0.
+            alpha_devil(iq)=0.
+            qextrhor(iq)= 0.
+         endif
+        enddo ! do iq=1,nqmx
+      endif
+
+c     Initialization for water vapor
+c     ------------------------------
+      if(water) then
+         radius(igcm_h2o_vap)=0.
+         Qext(igcm_h2o_vap)=0.
+         alpha_lift(igcm_h2o_vap) =0.
+         alpha_devil(igcm_h2o_vap)=0.
+         qextrhor(igcm_h2o_vap)= 0.
+
+c       "Dryness coefficient" controlling the evaporation and
+c        sublimation from the ground water ice (close to 1)
+c        HERE, the goal is to correct for the fact
+c        that the simulated permanent water ice polar caps
+c        is larger than the actual cap and the atmospheric
+c        opacity not always realistic.
+
+         do ig=1,ngridmx
+           if (ngridmx.ne.1) watercaptag(ig)=.false.
+           dryness(ig) = 1.
+         enddo
+
+         IF (caps) THEN
+c Perennial H20 north cap defined by watercaptag=true (allows surface to be
+c hollowed by sublimation in vdifc).
+         do ig=1,ngridmx
+           if (lati(ig)*180./pi.gt.84) then
+             if (ngridmx.ne.1) watercaptag(ig)=.true.
+             dryness(ig) = 1.
+c Use the following cap definition for high spatial resolution (latitudinal bin <= 5 deg)
+c	      if (lati(ig)*180./pi.lt.85.and.long(ig).ge.0) then
+c	        if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+c             if (lati(ig)*180./pi.ge.85) then
+c               if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+           endif  ! (lati>80 deg)
+         end do ! (ngridmx)
+        ENDIF ! (caps)
+
+         if(water.and.(nqmx.ge.2)) then
+           radius(igcm_h2o_ice)=3.e-6
+           rho_q(igcm_h2o_ice)=rho_ice
+           Qext(igcm_h2o_ice)=0.
+           alpha_lift(igcm_h2o_ice) =0.
+           alpha_devil(igcm_h2o_ice)=0.
+           qextrhor(igcm_h2o_ice)= (3./4.)*Qext(igcm_h2o_ice) 
+     $       / (rho_ice*radius(igcm_h2o_ice))
+         elseif(water.and.(nqmx.lt.2)) then
+            write(*,*) 'nqmx is too low : nqmx=', nqmx
+            write(*,*) 'water= ',water
+         endif
+
+      end if  ! (water)
+
+c     Output for records:
+c     ~~~~~~~~~~~~~~~~~~
+      write(*,*)
+      Write(*,*) '******** initracer : dust transport parameters :'
+      write(*,*) 'alpha_lift = ', alpha_lift
+      write(*,*) 'alpha_devil = ', alpha_devil
+      write(*,*) 'radius  = ', radius
+      if(doubleq) then
+        write(*,*) 'reff_lift (um) =  ', reff_lift
+        write(*,*) 'size distribution variance  = ', varian
+        write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+      end if
+      write(*,*) 'Qext  = ', qext 
+      write(*,*)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwrite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwrite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwrite.F	(revision 46)
@@ -0,0 +1,359 @@
+      SUBROUTINE iniwrite(nid,idayref,phis)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   'Initialize' the diagfi.nc file: write down dimensions as well
+c   as time-independent fields (e.g: geopotential, mesh area, ...)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+!include "comconst.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include"dimphys.h"
+#include"comsoil.h"
+
+c   Arguments:
+c   ----------
+
+      integer nid        ! NetCDF file ID
+      INTEGER*4 idayref  ! date (initial date for this run)
+      REAL phis(ip1jmp1) ! surface geopotential
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! run parameters are stored in this array
+      INTEGER ierr
+
+      integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+      integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
+      integer, dimension(2) :: id  
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = FLOAT(iim)
+      tab_cntrl(2)  = FLOAT(jjm)
+      tab_cntrl(3)  = FLOAT(llm)
+      tab_cntrl(4)  = FLOAT(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Define dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "interlayer", (llm+1), idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+c
+      ierr = NF_ENDDEF(nid)
+
+c  Contol parameters for this run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                       "Control parameters")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  longitudes and latitudes
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
+     .                       "Longitudes at u nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, 
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, 
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+     .                       "Latitudes at v nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
+#endif
+c
+c --------------------------
+c  Vertical levels
+      call def_var(nid,"aps","hybrid pressure at midlayers ","Pa",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      call def_var(nid,"ap","hybrid pressure at interlayers","Pa",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+
+      call def_var(nid,"bp","hybrid sigma at interlayers"," ",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+c
+c --------------------------
+c  Mesh area and conversion coefficients cov. <-> contra. <--> natural
+
+      id(1)=idim_rlonu
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatv
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c  Surface geopotential
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .                       "Geopotential at the surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+
+      write(*,*)'iniwrite: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      write(*,*)'iniwrite: rad,omeg,g,mugaz,rcp',
+     s rad,omeg,g,mugaz,rcp
+      write(*,*)'iniwrite: daysec,dtphys',daysec,dtphys
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwritesoil.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwritesoil.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/iniwritesoil.F90	(revision 46)
@@ -0,0 +1,272 @@
+subroutine iniwritesoil(nid)
+
+! initialization routine for 'writediagoil'. Here we create/define
+! dimensions (longitude, latitude, depth and time) and other fixed
+! (time-independent) parameters.
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"paramet.h"
+#include"comcstfi.h"
+#include"comgeom.h"
+#include"comsoil.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: nid ! NetCDF output file ID
+
+! Local variables:
+
+! NetCDF stuff:
+integer :: ierr ! NetCDF routines return code
+integer :: idim_rlatu ! ID of the 'latitude' dimension
+integer :: idim_rlonv ! ID of the 'longitude' dimension
+integer :: idim_depth ! ID of the 'depth' dimension
+integer :: idim_time  ! ID of the 'time' dimension
+integer :: varid ! to store NetCDF ID of a variable
+integer,dimension(3) :: dimids ! to store IDs of dimensions of a variable
+character(len=60) :: text ! to store some text
+real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+integer :: i,j,l,ig0
+
+! 1. Define the dimensions
+! Switch to NetCDF define mode
+ierr=NF_REDEF(nid)
+
+! Define the dimensions
+ierr=NF_DEF_DIM(nid,"longitude",iip1,idim_rlonv)
+! iip1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"latitude",jjp1,idim_rlatu)
+! jjp1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"depth",nsoilmx,idim_depth)
+! nsoilmx known from dimphys.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth dimension"
+endif
+ierr=NF_DEF_DIM(nid,"time",NF_UNLIMITED,idim_time)
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define time dimension"
+endif
+
+! Switch out of NetCDF define mode
+ierr=NF_ENDDEF(nid)
+
+! 2. Define (as variables) and write dimensions, as well as their attributes
+! 2.1. Longitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,varid)
+#else
+ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude variable"
+endif
+
+! Longitude attributes
+text="East longitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_east"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write longitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlonv*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlonv*(180./pi))
+#endif
+! Note: rlonv is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.2. Latitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,varid)
+#else
+ierr=NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude variable"
+endif
+
+! Latitude attributes
+text="North latitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_north"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write latitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlatu*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlatu*(180./pi))
+#endif
+! Note: rlatu is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.3. Depth
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"depth",NF_DOUBLE,1,idim_depth,varid)
+#else
+ierr=NF_DEF_VAR(nid,"depth",NF_FLOAT,1,idim_depth,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! Depth attributes
+text="Soil mid-layer depth"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+text="down"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"positive",len_trim(text),text)
+
+! Write depth to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,mlayer)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,mlayer)
+#endif
+! Note mlayer(0:nsoilmx-1) known from comsoil.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write depth variable"
+endif
+
+! 2.4. Time
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"time",NF_DOUBLE,1,idim_time,varid)
+#else
+ierr=NF_DEF_VAR(nid,"time",NF_FLOAT,1,idim_time,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! time attributes
+text="Time"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="days since 0000-01-01 00:00:00"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Note no need to write time variable here; it is done in writediagsoil.
+
+! 3. Other variables to be included
+
+! 3.1 mesh area surrounding each horizontal point
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"area",NF_DOUBLE,2,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"area",NF_FLOAT,2,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define area variable"
+endif
+
+! Area attributes
+text="Mesh area"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m2"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write area to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,aire)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,aire)
+#endif
+! Note: aire is known from comgeom.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write area variable"
+endif
+
+! 3.2 Thermal inertia
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+dimids(3)=idim_depth ! ID of the 'depth' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_DOUBLE,3,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_FLOAT,3,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define th_inertia variable"
+endif
+
+! Attributes
+text="Thermal inertia"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="J.s-1/2.m-2.K-1"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Recast data along 'dynamics' grid
+! Note: inertiedat is known from comsoil.h
+
+do l=1,nsoilmx
+  ! handle the poles
+  do i=1,iip1
+    data3(i,1,l)=inertiedat(1,l)
+    data3(i,jjp1,l)=inertiedat(ngridmx,l)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data3(i,j,l)=inertiedat(ig0+i,l)
+    enddo
+    data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+  enddo
+enddo ! of do l=1,nsoilmx
+
+! Write data2 to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,data3)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,data3)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write th_inertia variable"
+endif
+
+end subroutine iniwritesoil
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/interp_line.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/interp_line.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/interp_line.F	(revision 46)
@@ -0,0 +1,55 @@
+      subroutine interp_line(x1,y1,len1,x2,y2,len2)
+      implicit none
+!-----------------------------------------------------------------------
+!
+!  Purpose: Do a series of linear interpolations
+!  Data sets are organized as vectors (see below)
+!  If x2(:), and abscissa at which interpolation is requiered, lies
+!  outside of the interval covered by x1(:), instead of doing an
+!  extrapolation, y2() is set to the value y1() corresponding to
+!  the nearby x1(:) point
+!  
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      real x1(len1) ! ordered list of abscissas
+      real y1(len1) ! values at x1(:)
+      integer len1  ! length of x1(:) and y1(:)
+      real x2(len2) !ordered list of abscissas at which interpolation is done
+      integer len2  ! length of x2(:) and y2(:)
+!  outputs:
+      real y2(len2) ! interpolated values
+!-----------------------------------------------------------------------
+
+! local variables:
+      integer i,j
+      
+
+      do i=1,len2
+        ! check if x2(i) lies outside of the interval covered by x1()
+        if(((x2(i).le.x1(1)).and.(x2(i).le.x1(len1))).or.
+     &     ((x2(i).ge.x1(1)).and.(x2(i).ge.x1(len1)))) then
+	  ! set y2(i) to y1(1) or y1(len1)
+	  if (abs(x2(i)-x1(1)).lt.abs(x2(i)-x1(len1))) then
+	    ! x2(i) lies closest to x1(1)
+	    y2(i)=y1(1)
+	  else
+	    ! x2(i) lies closest to x1(len1)
+	    y2(i)=y1(len1)
+	  endif
+
+	else
+        ! find the nearest neigbours and do a linear interpolation
+	 do j=1,len1-1
+          if(((x2(i).ge.x1(j)).and.(x2(i).le.x1(j+1))).or.
+     &       ((x2(i).le.x1(j)).and.(x2(i).ge.x1(j+1)))) then
+	    y2(i)=((x2(i)-x1(j))/(x1(j+1)-x1(j)))*y1(j+1)+
+     &            ((x2(i)-x1(j+1))/(x1(j)-x1(j+1)))*y1(j)
+	  endif
+	 enddo
+	endif
+
+      enddo
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismax.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismax.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismax.F	(revision 46)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismin.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismin.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/ismin.F	(revision 46)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+      ix=ix+incx
+      if(sx(ix).lt.sxmin) then
+        sxmin=sx(ix)
+        ismin=i+1
+      endif
+      ENDDO
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerave.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerave.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerave.F	(revision 46)
@@ -0,0 +1,194 @@
+      SUBROUTINE aerave ( ndata,
+     & longdata,epdata,omegdata,gdata,          
+     &            longref,epref,temp,nir,longir
+     &            ,epir,omegir,gir,qref,omegaref        )
+      IMPLICIT NONE
+c.......................................................................
+c
+c R.Fournier 02/1996 
+c (modif F.Forget 02/1996)
+c le spectre est decoupe en "nir" bandes et cette routine calcule
+c les donnees radiatives moyenne sur chaque bande : l'optimisation
+c est faite pour une temperature au sol "temp" et une epaisseur
+c optique de l'atmosphere "epref" a la longueur d'onde "longref"
+c
+c dans la version actuelle, les ponderations sont independantes de
+c l'epaisseur optique : c'est a dire que "omegir", "gir"
+c et "epir/epre" sont independants de "epref".
+c en effet les ponderations sont choisies pour une solution exacte
+c en couche mince et milieu isotherme. 
+c
+c entree
+c
+c    ndata : taille des champs data
+c    longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
+c                  (longdata longueur d'onde en METRES)
+c  * longref : longueur d'onde a laquelle l'epaisseur optique
+c              est connue
+c  * epref : epaisseur optique a longref
+c  * temp : temperature choisie pour la ponderation (Planck)
+c  * nir : nombre d'intervals dans la discretisation spectrale
+c           du GCM
+c  * longir : longueurs d'onde definissant ces intervals
+c
+c sortie
+c
+c  * epir : epaisseur optique moyenne pour chaque interval
+c  * omegir : "scattering albedo" moyen pour chaque interval
+c  * gir : "assymetry factor" moyen pour chaque interval
+c  * qref : extinction coefficient at reference wavelength
+c  * omegaref : single scat. albedo at reference wavelength
+c
+c.......................................................................
+c
+      REAL longref
+      REAL epref
+      REAL temp
+      INTEGER nir
+      REAL longir(nir+1)
+      REAL epir(nir)
+      REAL omegir(nir)
+      REAL gir(nir)
+c
+c.......................................................................
+c
+      INTEGER iir,nirmx
+      PARAMETER (nirmx=100)
+      INTEGER idata,ndata
+c
+c.......................................................................
+c
+      REAL emit
+      REAL totalemit(nirmx)
+      REAL longdata(ndata),epdata(ndata)
+     &    ,omegdata(ndata),gdata(ndata)
+      REAL qextcorrdata(ndata)
+      INTEGER ibande,nbande
+      PARAMETER (nbande=1000)
+      REAL long,deltalong
+      INTEGER ilong
+      INTEGER i1,i2
+      REAL c1,c2
+      REAL factep,qextcorr,omeg,g
+      REAL qref,omegaref
+c
+c.......................................................................
+c
+      DOUBLE PRECISION tmp1
+      REAL tmp2,tmp3
+c
+c
+      long=longref
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+      qref=c1*epdata(i1)+c2*epdata(i2)
+      omegaref=c1*omegdata(i1)+c2*omegdata(i2)
+      factep=qref/epref
+      DO idata=1,ndata
+        qextcorrdata(idata)=epdata(idata)/factep
+      ENDDO
+c
+c.......................................................................
+c
+      DO iir=1,nir
+c
+c.......................................................................
+c
+        deltalong=(longir(iir+1)-longir(iir)) / nbande
+        totalemit(iir)=0.E+0
+        epir(iir)=0.E+0
+        omegir(iir)=0.E+0
+        gir(iir)=0.E+0
+c
+c.......................................................................
+c
+        DO ibande=1,nbande
+c
+c.......................................................................
+c
+          long=longir(iir) + (ibande-0.5E+0) * deltalong
+          CALL blackl(DBLE(long),DBLE(temp),tmp1)
+          emit=REAL(tmp1)
+c
+c.......................................................................
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+          qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
+          omeg=c1*omegdata(i1)+c2*omegdata(i2)
+          g=c1*gdata(i1)+c2*gdata(i2)
+c
+c.......................................................................
+c
+          totalemit(iir)=totalemit(iir)+deltalong*emit
+          epir(iir)=epir(iir)+deltalong*emit*qextcorr
+          omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
+          gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
+c
+c.......................................................................
+c
+        ENDDO
+c
+c.......................................................................
+c
+        gir(iir)=gir(iir)/omegir(iir)
+        omegir(iir)=omegir(iir)/epir(iir)
+        epir(iir)=epir(iir)/totalemit(iir)
+c
+c.......................................................................
+c
+      ENDDO
+c
+c......................................................................
+c
+c     Diagnostic de controle si on moyenne sur tout le spectre vis ou IR :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     tmp2=0.E+0
+c     DO iir=1,nir
+c       tmp2=tmp2+totalemit(iir)
+c     ENDDO
+c     tmp3=5.67E-8 * temp**4
+c     IF (abs((tmp2-tmp3)/tmp3).gt.0.05E+0) THEN
+c       PRINT *,'!!!! <---> il manque du Planck (voir moyenne.F)'
+c       PRINT *,'somme des bandes :',tmp2,'--- Planck:',tmp3
+c     ENDIF
+c
+c......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdata.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdata.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdata.h	(revision 46)
@@ -0,0 +1,134 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+c visible (Clancy and Lee, 1991)
+      integer ndatavis
+      parameter(ndatavis=2)
+      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndatair
+      parameter(ndatair=124)
+      REAL longdatair(ndatair),epdatair(ndatair)
+     &    ,omegdatair(ndatair),gdatair(ndatair)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdatavis/
+     & 0.210000E-06,0.414800E-05/
+      data epdatavis/2.5,2.5/
+      data omegdatavis/0.92,0.92/
+      data gdatavis/0.55,0.55/
+      data longdatair/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdatair/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdatair/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdatair/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h	(revision 46)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.clan91
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.clan91	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.clan91	(revision 46)
@@ -0,0 +1,135 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdust.h'
+c Spectral  Radiative properties of the Martian dust
+c SPECIAL "bright dust" (Clancy and Lee, 1991)
+
+
+c visible (Clancy and Lee, 1991)
+      integer ndustvis
+      parameter(ndustvis=2)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+
+      data longdustvis/
+     & 0.210000E-06,0.414800E-05/
+      data epdustvis/2.5,2.5/
+      data omegdustvis/0.92,0.92/
+      data gdustvis/0.55,0.55/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.ocke97
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.ocke97	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerdust.h.ocke97	(revision 46)
@@ -0,0 +1,167 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerdata.h'
+c Spectral  Radiative properties of the Martian dust
+
+c visible (composite; Ockert-Bell, 1996)
+!      integer ndatavis
+!      parameter(ndatavis=22)
+!      REAL longdatavis(ndatavis),epdatavis(ndatavis)
+!     &    ,omegdatavis(ndatavis),gdatavis(ndatavis)
+      integer ndustvis
+      parameter(ndustvis=22)
+      REAL longdustvis(ndustvis),epdustvis(ndustvis)
+     &    ,omegdustvis(ndustvis),gdustvis(ndustvis)
+
+
+c IR (composite: Toon 1977 (5-15micrometers) + Forget, 1996 (>15micrometers) 
+!      integer ndatair
+!      parameter(ndatair=124)
+!      REAL longdatair(ndatair),epdatair(ndatair)
+!     &    ,omegdatair(ndatair),gdatair(ndatair)
+      integer ndustir
+      parameter(ndustir=124)
+      REAL longdustir(ndustir),epdustir(ndustir)
+     &    ,omegdustir(ndustir),gdustir(ndustir)
+
+c Ratio solsir = Tau(vis) / Tau (9 microns)
+      REAL solsir
+      PARAMETER (solsir=2.E+0)
+
+c-----------------------------------------------------------------------
+       
+!      data longdatavis/
+      data longdustvis/
+     & 0.210000E-06,0.300000E-06,0.350000E-06,0.396000E-06,0.500000E-06
+     &,0.596000E-06,0.670000E-06,0.700000E-06,0.802000E-06,0.101500E-05
+     &,0.121000E-05,0.138800E-05,0.219600E-05,0.249000E-05,0.289800E-05
+     &,0.300000E-05,0.319300E-05,0.339600E-05,0.360400E-05,0.377600E-05
+     &,0.398000E-05,0.414800E-05/
+!      data epdatavis/
+      data epdustvis/
+     & 2.6279900,2.5766001,2.5974200,2.6333699,2.8306701
+     &,2.9744799,3.0389600,3.0630300,3.1325400,3.2430501
+     &,3.3174801,3.3595500,3.2457900,3.1078401,2.7780800
+     &,2.7713201,2.7360499,2.6556201,2.5405700,2.4204800
+     &,2.2459800,1.9280800/
+!      data omegdatavis/
+      data omegdustvis/
+     & 0.7495430,0.6030650,0.5962170,0.6119930,0.7942140
+     &,0.9040160,0.9288640,0.9370630,0.9486390,0.9521170
+     &,0.9540560,0.9558040,0.9550000,0.9511820,0.8042000
+     &,0.8244980,0.8807870,0.9260230,0.9545540,0.9594400
+     &,0.9581870,0.8693700/
+!      data gdatavis/
+      data gdustvis/
+     & 0.7858040,0.8816350,0.8781190,0.8550090,0.7232660
+     &,0.6684300,0.6547490,0.6502400,0.6412210,0.6326590
+     &,0.6283010,0.6261290,0.6281390,0.6306530,0.6707820
+     &,0.6652110,0.6506370,0.6400950,0.6341580,0.6334550
+     &,0.6341640,0.6506680/
+!      data longdatair/
+      data longdustir/
+     & 0.556000E-05,0.625000E-05,0.714000E-05,0.725000E-05,0.735000E-05
+     &,0.746000E-05,0.758000E-05,0.769000E-05,0.781000E-05,0.794000E-05
+     &,0.800000E-05,0.807000E-05,0.813000E-05,0.820000E-05,0.826000E-05
+     &,0.833000E-05,0.840000E-05,0.848000E-05,0.855000E-05,0.862000E-05
+     &,0.870000E-05,0.877000E-05,0.880000E-05,0.884956E-05,0.892857E-05
+     &,0.900901E-05,0.909091E-05,0.917431E-05,0.925926E-05,0.934579E-05
+     &,0.943396E-05,0.952381E-05,0.961539E-05,0.970874E-05,0.980392E-05
+     &,0.990099E-05,0.100000E-04,0.101010E-04,0.102041E-04,0.103093E-04
+     &,0.104167E-04,0.105263E-04,0.106383E-04,0.107527E-04,0.108696E-04
+     &,0.109890E-04,0.111111E-04,0.112360E-04,0.113636E-04,0.114942E-04
+     &,0.116279E-04,0.117647E-04,0.119048E-04,0.120482E-04,0.121951E-04
+     &,0.123457E-04,0.125000E-04,0.126582E-04,0.128205E-04,0.129870E-04
+     &,0.131579E-04,0.133333E-04,0.135135E-04,0.136986E-04,0.138889E-04
+     &,0.140845E-04,0.142857E-04,0.144928E-04,0.147059E-04,0.149254E-04
+     &,0.151515E-04,0.153846E-04,0.156250E-04,0.158730E-04,0.161290E-04
+     &,0.163934E-04,0.166667E-04,0.169492E-04,0.172414E-04,0.175439E-04
+     &,0.178571E-04,0.181818E-04,0.185185E-04,0.188679E-04,0.192308E-04
+     &,0.196078E-04,0.200000E-04,0.204082E-04,0.208333E-04,0.212766E-04
+     &,0.217391E-04,0.222222E-04,0.227273E-04,0.232558E-04,0.238095E-04
+     &,0.243902E-04,0.250000E-04,0.256410E-04,0.263158E-04,0.270270E-04
+     &,0.277778E-04,0.285714E-04,0.294118E-04,0.303030E-04,0.312500E-04
+     &,0.322581E-04,0.333333E-04,0.344828E-04,0.357143E-04,0.370370E-04
+     &,0.384615E-04,0.400000E-04,0.500000E-04,0.600000E-04,0.700000E-04
+     &,0.800000E-04,0.100000E-03,0.120000E-03,0.140000E-03,0.170000E-03
+     &,0.200000E-03,0.230000E-03,0.260000E-03,0.300000E-03/
+!      data epdatair/
+      data epdustir/
+     & 1.8223799,1.3646801,0.6918110,0.6400360,0.6000190
+     &,0.5436750,0.5075750,0.5349990,0.5741300,0.6528150
+     &,0.7026240,0.8045070,0.9152510,0.9964510,1.1199900
+     &,1.2508200,1.4647000,1.6723000,1.7668300,1.8770100
+     &,2.0622301,2.2681601,2.3134601,2.3844199,2.4568000
+     &,2.4623699,2.5139699,2.7634001,3.1062000,3.2699001
+     &,3.0982399,2.8657801,2.7559099,2.6911600,2.6657801
+     &,2.6558800,2.6744900,2.6645300,2.6016099,2.5456300
+     &,2.4316900,2.3356500,2.2314799,2.1130800,2.0792401
+     &,2.0617199,2.0427401,1.9252200,1.9074700,1.9007500
+     &,1.7614900,1.5749300,1.5687200,1.5357200,1.3301001
+     &,1.1643699,1.0552500,1.3750900,1.3406500,1.4579200
+     &,1.2703400,1.2499200,0.9752970,1.0887500,1.0551100
+     &,0.8680390,0.9080590,0.9270510,0.8930280,0.7252980
+     &,0.7761930,0.7722600,0.6197060,0.8046810,0.9906260
+     &,1.1675600,1.3232200,1.4563700,1.5742900,1.6683700
+     &,1.6386300,1.6082799,1.5773100,1.5452300,1.5131000
+     &,1.4803500,1.4470100,1.4130900,1.3785900,1.3430200
+     &,1.3074800,1.2714100,1.2348300,1.1977800,1.1602700
+     &,1.1218801,1.0836500,1.0450701,1.0062100,0.9670900
+     &,0.9273350,0.8879470,0.8485210,0.8090940,0.7697440
+     &,0.7305380,0.6912350,0.6527100,0.6146080,0.5770320
+     &,0.5400900,0.5038810,0.3378440,0.2453480,0.1899010
+     &,0.1543380,0.1124400,0.0889283,0.0739620,0.0593130
+     &,0.0496814,0.0428006,0.0376627,0.0324836/
+!      data omegdatair/
+      data omegdustir/
+     & 0.9455460,0.9255780,0.6110340,0.5893190,0.4896250
+     &,0.3736060,0.2719810,0.1933450,0.1591350,0.1584020
+     &,0.1842620,0.2511510,0.2616600,0.2910640,0.3243100
+     &,0.3532210,0.3744530,0.3675350,0.3614250,0.3678870
+     &,0.3820890,0.3866010,0.3842250,0.3821830,0.3814160
+     &,0.3779760,0.3837150,0.4103900,0.4473680,0.4952290
+     &,0.5245740,0.5125160,0.4980300,0.4833010,0.4788940
+     &,0.4769360,0.4898900,0.5542500,0.5697640,0.6304710
+     &,0.6634610,0.6500820,0.6469200,0.6292330,0.5847980
+     &,0.5847600,0.6166800,0.6622360,0.6334560,0.6793890
+     &,0.7708860,0.7351760,0.6715080,0.7118780,0.8014710
+     &,0.7203560,0.5123400,0.4070190,0.4575710,0.4804760
+     &,0.5493510,0.5477680,0.5564710,0.5089200,0.5221230
+     &,0.5291490,0.4292840,0.4024670,0.4110070,0.3907940
+     &,0.3085770,0.2905000,0.2411480,0.3065880,0.3493080
+     &,0.3836540,0.4065040,0.4211960,0.4325340,0.4396850
+     &,0.4379220,0.4360720,0.4341270,0.4320340,0.4298880
+     &,0.4276300,0.4252520,0.4227480,0.4201070,0.4172670
+     &,0.4143320,0.4112310,0.4079530,0.4044860,0.4008160
+     &,0.3968690,0.3927530,0.3883870,0.3837510,0.3788250
+     &,0.3735170,0.3679440,0.3620120,0.3556900,0.3489460
+     &,0.3417450,0.3339700,0.3257680,0.3170010,0.3076270
+     &,0.2976060,0.2868930,0.2218360,0.1676840,0.1255320
+     &,0.0942349,0.0544707,0.0330144,0.0214071,0.0119898
+     &,0.0073572,0.0047672,0.0033577,0.0022074/
+!      data gdatair/
+      data gdustir/
+     & 0.7727880,0.7891680,0.8149010,0.8143680,0.8141810
+     &,0.8135650,0.8105500,0.8033680,0.7936510,0.7786140
+     &,0.7633720,0.7376310,0.7232250,0.7045770,0.6794170
+     &,0.6532190,0.6216970,0.6061300,0.6006830,0.5882300
+     &,0.5672470,0.5528980,0.5515480,0.5486130,0.5436640
+     &,0.5431460,0.5333350,0.5041380,0.4678710,0.4283810
+     &,0.4064880,0.4156190,0.4282650,0.4454850,0.4535160
+     &,0.4693080,0.4752720,0.4885620,0.5029940,0.5025310
+     &,0.5189140,0.5377080,0.5533670,0.5710530,0.5778970
+     &,0.5762890,0.5706920,0.5760510,0.5783530,0.5683710
+     &,0.5678870,0.5920300,0.5962880,0.5909690,0.5981750
+     &,0.6187920,0.6339570,0.6020770,0.6024800,0.5877340
+     &,0.5985190,0.5957170,0.6125820,0.6001100,0.5978010
+     &,0.6065740,0.5983230,0.5910160,0.5887040,0.5944530
+     &,0.5810070,0.5743440,0.5758550,0.5615340,0.5437820
+     &,0.5243770,0.5039760,0.4829940,0.4609260,0.4389000
+     &,0.4355460,0.4321260,0.4286380,0.4247460,0.4211400
+     &,0.4174550,0.4136880,0.4098350,0.4058920,0.4015100
+     &,0.3974090,0.3932030,0.3888870,0.3844560,0.3799040
+     &,0.3748690,0.3700950,0.3651760,0.3601050,0.3548730
+     &,0.3490900,0.3435280,0.3377980,0.3318590,0.3256990
+     &,0.3192870,0.3122380,0.3053810,0.2982310,0.2907650
+     &,0.2829610,0.2747820,0.2274640,0.1885150,0.1562300
+     &,0.1306820,0.0917524,0.0638560,0.0486232,0.0311882
+     &,0.0219897,0.0157278,0.0129793,0.0101294/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.005
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.005	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.005	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 0.5 MICRONS (Franck Montmessin) 
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=65.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=.5e-6,qrefice=2.8)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1832037,3.0220087,2.4477277,1.7936502,0.7896869,
+     &0.3638896,0.0989704,0.1296485,0.4747359,0.6042269,
+     &0.7391522,0.8270491,0.9101521,1.0053538,1.1204786,
+     &1.2478381,1.3907613,1.5331460,1.5983437,1.5859528,
+     &1.5294470,1.4795980,1.4226713,1.3357474,1.2130061,
+     &1.0765146,0.9549081,0.8522044,0.7333566,0.6579455,
+     &0.5836973,0.5145633,0.4580996,0.4042850,0.3620397,
+     &0.3252469,0.2931417,0.2685316,0.2455204,0.2259372,
+     &0.2092481,0.1779757,0.1460140,0.1362165,0.1238611,
+     &0.1114724,0.1013308,0.0958610,0.0989326,0.1026265,
+     &0.1056360,0.1088488,0.1078976,0.1089309,0.1056082,
+     &0.0775238,0.0604925,0.0548426/
+       data epiceir/
+     &0.0518859,0.0499921,0.0489281,0.0504541,0.0563693,
+     &0.0690525,0.0726885,0.0778081,0.0828819,0.0909149,
+     &0.0975723,0.1109497,0.1108328,0.1043100,0.1007861,
+     &0.0985987,0.0951375,0.0903377,0.0868122,0.0846175,
+     &0.0815860,0.0824196,0.0820647,0.0784795,0.0737793,
+     &0.0722562,0.0696436,0.0659283,0.0645018,0.0631230,
+     &0.0617881,0.0583767,0.0540010,0.0487309,0.0435927,
+     &0.0405531,0.0414796,0.0409568,0.0413717,0.0422409,
+     &0.0421894,0.0416819,0.0412459,0.0438362,0.0547753,
+     &0.0626479,0.0729752,0.0890032,0.1097846,0.1367236,
+     &0.1645632,0.1977923,0.2204414,0.2592581,0.2749909,
+     &0.2818336,0.2731296,0.2562519,0.2294758,0.2146772,
+     &0.2003647,0.1846708,0.1704422,0.1563350,0.1425573,
+     &0.1287259,0.1145926,0.0897004,0.0727098,0.0659172,
+     &0.0615737,0.0541199,0.0521104,0.0503624,0.0466379,
+     &0.0422906,0.0299038,0.0264714,0.0274238,0.0264572,
+     &0.0231405,0.0186739,0.0150726,0.0092988,0.0087124,
+     &0.0084247,0.0083568,0.0085502,0.0087600,0.0096209,
+     &0.0139307,0.0186971,0.0250932,0.0314043,0.0401234,
+     &0.0493907,0.0591965,0.0683152,0.0781187,0.0888679,
+     &0.0974246,0.1010759,0.1059724,0.1067670,0.1021143,
+     &0.0896822,0.0784708,0.0693838,0.0645370,0.0599980,
+     &0.0540903,0.0504870,0.0469609,0.0408812,0.0363856,
+     &0.0326679,0.0299615,0.0284745,0.0328476,0.0366500,
+     &0.0404568,0.0452998,0.0461202,0.0442455,0.0428461,
+     &0.0412572,0.0394165,0.0369267,0.0336194,0.0301124,
+     &0.0269362,0.0227761,0.0199896,0.0184862,0.0138242,
+     &0.0116880,0.0108555,0.0101642,0.0089899,0.0079631,
+     &0.0071303,0.0051857,0.0033162,0.0025556/
+       data omegicevis/
+     &0.5254589,1.0000000,0.9999991,0.9999862,0.9916013,
+     &0.9620332,0.9309642,0.0638710,0.0662553,0.0823147,
+     &0.0963694,0.1048159,0.1133009,0.1232222,0.1352970,
+     &0.1488444,0.1650357,0.1841903,0.2017575,0.2166039,
+     &0.2292029,0.2433622,0.2616843,0.2852339,0.3131889,
+     &0.3412718,0.3660752,0.3928272,0.4309901,0.4492646,
+     &0.4801873,0.5139056,0.5460804,0.5844365,0.6146011,
+     &0.6468718,0.6772872,0.6975922,0.7236167,0.7461668,
+     &0.7655625,0.7888166,0.7862524,0.7823967,0.7588729,
+     &0.6857340,0.6214526,0.5368491,0.4470918,0.4119983,
+     &0.3805366,0.3541514,0.3503601,0.3458159,0.3562116,
+     &0.4411552,0.4703839,0.4680012/
+       data omegiceir/
+     &0.4410178,0.4089485,0.3886294,0.3210695,0.2419387,
+     &0.1693097,0.1560958,0.1421160,0.1303703,0.1174139,
+     &0.1096975,0.0955347,0.0956753,0.0990973,0.1009341,
+     &0.1015035,0.1034342,0.1062110,0.1070629,0.1064178,
+     &0.1036404,0.0972966,0.0935797,0.0912126,0.0893898,
+     &0.0863554,0.0848208,0.0840290,0.0804088,0.0772171,
+     &0.0744647,0.0741630,0.0747523,0.0763844,0.0774963,
+     &0.0745925,0.0657440,0.0572360,0.0481501,0.0421850,
+     &0.0375024,0.0306774,0.0232991,0.0167966,0.0100478,
+     &0.0075047,0.0055527,0.0042542,0.0036752,0.0036866,
+     &0.0039804,0.0045186,0.0049973,0.0059663,0.0067372,
+     &0.0074513,0.0081464,0.0088094,0.0094550,0.0097817,
+     &0.0101162,0.0104466,0.0107313,0.0110585,0.0114425,
+     &0.0118786,0.0123615,0.0132487,0.0135842,0.0136287,
+     &0.0132877,0.0127042,0.0121676,0.0117236,0.0118197,
+     &0.0120773,0.0129020,0.0118840,0.0105257,0.0101722,
+     &0.0107762,0.0121118,0.0133881,0.0149663,0.0144329,
+     &0.0133009,0.0117145,0.0090358,0.0080348,0.0058144,
+     &0.0023043,0.0010388,0.0004725,0.0003068,0.0002241,
+     &0.0001846,0.0001716,0.0001686,0.0001696,0.0001738,
+     &0.0001855,0.0001962,0.0002120,0.0002308,0.0002526,
+     &0.0002702,0.0002761,0.0002683,0.0002543,0.0002499,
+     &0.0002511,0.0002545,0.0002619,0.0002746,0.0002779,
+     &0.0002773,0.0002686,0.0002502,0.0001890,0.0001591,
+     &0.0001434,0.0001354,0.0001372,0.0001437,0.0001462,
+     &0.0001491,0.0001526,0.0001578,0.0001639,0.0001681,
+     &0.0001709,0.0001735,0.0001751,0.0001759,0.0001954,
+     &0.0001839,0.0001755,0.0001695,0.0001556,0.0001422,
+     &0.0001276,0.0000821,0.0000525,0.0000447/
+       data gicevis/
+     &0.9440147,0.7965972,0.8107608,0.7669883,0.6258456,
+     &0.4763368,0.3164644,0.2653029,0.2540545,0.2543145,
+     &0.2552853,0.2555421,0.2551991,0.2546355,0.2543354,
+     &0.2544852,0.2551972,0.2571523,0.2610470,0.2657359,
+     &0.2696103,0.2723087,0.2749877,0.2770225,0.2766140,
+     &0.2729803,0.2674728,0.2618006,0.2547111,0.2485000,
+     &0.2423996,0.2361834,0.2305830,0.2249461,0.2198020,
+     &0.2149920,0.2103154,0.2060570,0.2018775,0.1979253,
+     &0.1941856,0.1853729,0.1727509,0.1681767,0.1610373,
+     &0.1502239,0.1399678,0.1301550,0.1233758,0.1211795,
+     &0.1180928,0.1149843,0.1129097,0.1123236,0.1113603,
+     &0.1042673,0.0958210,0.0918495/
+       data giceir/
+     &0.0879977,0.0844017,0.0822360,0.0778328,0.0732655,
+     &0.0690960,0.0682752,0.0674878,0.0666989,0.0659700,
+     &0.0653013,0.0618198,0.0604822,0.0583973,0.0576873,
+     &0.0569741,0.0562715,0.0555336,0.0547710,0.0540252,
+     &0.0525653,0.0511566,0.0498082,0.0478042,0.0458238,
+     &0.0445190,0.0432495,0.0419659,0.0407013,0.0394739,
+     &0.0382847,0.0371085,0.0359234,0.0347448,0.0335567,
+     &0.0323681,0.0312087,0.0295399,0.0279082,0.0268502,
+     &0.0258095,0.0242507,0.0226832,0.0216094,0.0205569,
+     &0.0199994,0.0194464,0.0189064,0.0183935,0.0179262,
+     &0.0174721,0.0170318,0.0167252,0.0161173,0.0156093,
+     &0.0151735,0.0148010,0.0144899,0.0141909,0.0140236,
+     &0.0138500,0.0136646,0.0134407,0.0131990,0.0129545,
+     &0.0126989,0.0123981,0.0117364,0.0110220,0.0106622,
+     &0.0102900,0.0096114,0.0092885,0.0089773,0.0086913,
+     &0.0084029,0.0075082,0.0069195,0.0066498,0.0064030,
+     &0.0061638,0.0059125,0.0056564,0.0049044,0.0047217,
+     &0.0045194,0.0042905,0.0039171,0.0037807,0.0034683,
+     &0.0028199,0.0023535,0.0019931,0.0018378,0.0017011,
+     &0.0015627,0.0014514,0.0013460,0.0012398,0.0011386,
+     &0.0010917,0.0010505,0.0010140,0.0010014,0.0010106,
+     &0.0010385,0.0010523,0.0010404,0.0009990,0.0009673,
+     &0.0009376,0.0009252,0.0009159,0.0009061,0.0008860,
+     &0.0008628,0.0008361,0.0008086,0.0007567,0.0007210,
+     &0.0006967,0.0006727,0.0006705,0.0006603,0.0006463,
+     &0.0006386,0.0006316,0.0006257,0.0006182,0.0006034,
+     &0.0005850,0.0005536,0.0005284,0.0005128,0.0004754,
+     &0.0004328,0.0004100,0.0003918,0.0003559,0.0003223,
+     &0.0002906,0.0002006,0.0001287,0.0001043/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.01
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.01	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.01	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 1 MICRONS (Franck M ontmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=23.E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-6,qrefice=2.75)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.1192634,2.3866904,3.0710473,3.2044775,2.4812233,
+     &1.5408986,0.5308650,0.2823303,0.8151994,0.9982054,
+     &1.1776563,1.2913215,1.3945227,1.5075399,1.6387790,
+     &1.7810757,1.9404513,2.1077142,2.2311430,2.3039091,
+     &2.3424239,2.3839264,2.4322689,2.4745319,2.4916942,
+     &2.4703403,2.4206913,2.3665223,2.2752666,2.1747661,
+     &2.0781898,1.9706942,1.8699772,1.7651500,1.6681471,
+     &1.5780047,1.4902014,1.4125437,1.3384955,1.2692254,
+     &1.2053254,1.0666140,0.9020291,0.8492430,0.7754933,
+     &0.6846126,0.6097632,0.5495253,0.5234407,0.5223706,
+     &0.5196257,0.5199762,0.5163358,0.5186846,0.5133317,
+     &0.4363440,0.3637202,0.3336293/
+       data epiceir/
+     &0.3097547,0.2899992,0.2780589,0.2617716,0.2548404,
+     &0.2650286,0.2694660,0.2773825,0.2855305,0.3007740,
+     &0.3150952,0.3452618,0.3475289,0.3352611,0.3274985,
+     &0.3222899,0.3144871,0.3029351,0.2930705,0.2859025,
+     &0.2744837,0.2721885,0.2687397,0.2570274,0.2420578,
+     &0.2354512,0.2268017,0.2151964,0.2083238,0.2020417,
+     &0.1963370,0.1862280,0.1736113,0.1585643,0.1430934,
+     &0.1316877,0.1294224,0.1228625,0.1185373,0.1171891,
+     &0.1139945,0.1080297,0.1016796,0.1029433,0.1216047,
+     &0.1356978,0.1546041,0.1849135,0.2246722,0.2768484,
+     &0.3310658,0.3965377,0.4426499,0.5253468,0.5668955,
+     &0.5922215,0.5880766,0.5654298,0.5190575,0.4913011,
+     &0.4635427,0.4314885,0.4015174,0.3712321,0.3411348,
+     &0.3102629,0.2780339,0.2194865,0.1779260,0.1610434,
+     &0.1496597,0.1303599,0.1247039,0.1198948,0.1110008,
+     &0.1007371,0.0712706,0.0622413,0.0636172,0.0611146,
+     &0.0536605,0.0437097,0.0355698,0.0220631,0.0205425,
+     &0.0196398,0.0191828,0.0191171,0.0193923,0.0208254,
+     &0.0290338,0.0383325,0.0509648,0.0635566,0.0810146,
+     &0.0995692,0.1192388,0.1375636,0.1572995,0.1789836,
+     &0.1963544,0.2039599,0.2141546,0.2161427,0.2071475,
+     &0.1822319,0.1595332,0.1409966,0.1310656,0.1218277,
+     &0.1098314,0.1025169,0.0953714,0.0830212,0.0738609,
+     &0.0662767,0.0607402,0.0576721,0.0664149,0.0740372,
+     &0.0816919,0.0914682,0.0931417,0.0893927,0.0865822,
+     &0.0833833,0.0796740,0.0746523,0.0679690,0.0608707,
+     &0.0544375,0.0460094,0.0403652,0.0373210,0.0279000,
+     &0.0235664,0.0218776,0.0204772,0.0180988,0.0160214,
+     &0.0143370,0.0104088,0.0066479,0.0051210/
+       data omegicevis/
+     &0.5386420,1.0000000,0.9999983,0.9999850,0.9955066,
+     &0.9844767,0.9774309,0.1614970,0.1627708,0.1939070,
+     &0.2183838,0.2320055,0.2452919,0.2601796,0.2772272,
+     &0.2949594,0.3144796,0.3355922,0.3536791,0.3691771,
+     &0.3833629,0.3993029,0.4197326,0.4469427,0.4815640,
+     &0.5188605,0.5528998,0.5873977,0.6337127,0.6578971,
+     &0.6923810,0.7275212,0.7585961,0.7921193,0.8169167,
+     &0.8410107,0.8620409,0.8756065,0.8913837,0.9042724,
+     &0.9147988,0.9275904,0.9291340,0.9284223,0.9196891,
+     &0.8876197,0.8561562,0.8072060,0.7431433,0.7140535,
+     &0.6865323,0.6620798,0.6595058,0.6550942,0.6665309,
+     &0.7495020,0.7778903,0.7786440/
+       data omegiceir/
+     &0.7604749,0.7366999,0.7205958,0.6580536,0.5668025,
+     &0.4587096,0.4356672,0.4097329,0.3868122,0.3598266,
+     &0.3431242,0.3130278,0.3147338,0.3254214,0.3307036,
+     &0.3329236,0.3383887,0.3458877,0.3488805,0.3483467,
+     &0.3436954,0.3301307,0.3225699,0.3191252,0.3170218,
+     &0.3108034,0.3083988,0.3079879,0.2998554,0.2926259,
+     &0.2863949,0.2870713,0.2903223,0.2965344,0.3012683,
+     &0.2946250,0.2699749,0.2452659,0.2165022,0.1961797,
+     &0.1795562,0.1537112,0.1230571,0.0931165,0.0588126,
+     &0.0449536,0.0339055,0.0263423,0.0229347,0.0230562,
+     &0.0248910,0.0281887,0.0311059,0.0369957,0.0417154,
+     &0.0460758,0.0503238,0.0543560,0.0582899,0.0602842,
+     &0.0623192,0.0643389,0.0661152,0.0681381,0.0704755,
+     &0.0731053,0.0760185,0.0814240,0.0838108,0.0843268,
+     &0.0827206,0.0799519,0.0771474,0.0748236,0.0755603,
+     &0.0772232,0.0825206,0.0770989,0.0693231,0.0673670,
+     &0.0711028,0.0790820,0.0865735,0.0959862,0.0931518,
+     &0.0868936,0.0778482,0.0618916,0.0556907,0.0414274,
+     &0.0172511,0.0079517,0.0036608,0.0023874,0.0017483,
+     &0.0014435,0.0013443,0.0013223,0.0013315,0.0013663,
+     &0.0014583,0.0015426,0.0016673,0.0018146,0.0019850,
+     &0.0021217,0.0021683,0.0021083,0.0019995,0.0019657,
+     &0.0019761,0.0020031,0.0020611,0.0021607,0.0021879,
+     &0.0021838,0.0021172,0.0019728,0.0014927,0.0012580,
+     &0.0011338,0.0010718,0.0010859,0.0011371,0.0011565,
+     &0.0011796,0.0012070,0.0012485,0.0012965,0.0013299,
+     &0.0013524,0.0013734,0.0013868,0.0013938,0.0015480,
+     &0.0014583,0.0013921,0.0013452,0.0012361,0.0011303,
+     &0.0010147,0.0006545,0.0004192,0.0003572/
+       data gicevis/
+     &0.9472355,0.7817819,0.8104869,0.8370932,0.8250610,
+     &0.7729445,0.6907796,0.6560782,0.6408569,0.6389719,
+     &0.6383793,0.6379554,0.6365179,0.6343526,0.6319877,
+     &0.6300194,0.6284310,0.6279051,0.6303032,0.6338103,
+     &0.6368135,0.6378741,0.6381156,0.6375306,0.6352661,
+     &0.6311954,0.6260597,0.6201031,0.6121832,0.6065006,
+     &0.5996023,0.5927197,0.5867192,0.5807193,0.5757619,
+     &0.5710542,0.5665758,0.5626292,0.5584362,0.5544021,
+     &0.5504646,0.5406969,0.5247300,0.5183126,0.5077586,
+     &0.4904415,0.4721469,0.4530136,0.4389606,0.4342998,
+     &0.4274060,0.4202327,0.4151474,0.4137563,0.4111845,
+     &0.3915503,0.3674690,0.3556202/
+       data giceir/
+     &0.3438542,0.3325318,0.3255288,0.3110588,0.2956603,
+     &0.2814386,0.2786329,0.2760077,0.2733599,0.2710718,
+     &0.2689575,0.2567067,0.2516982,0.2434593,0.2405528,
+     &0.2376774,0.2347744,0.2316430,0.2284427,0.2253558,
+     &0.2193370,0.2136727,0.2081797,0.1998119,0.1914108,
+     &0.1859097,0.1804893,0.1749370,0.1695419,0.1642952,
+     &0.1592050,0.1540809,0.1488775,0.1436688,0.1384313,
+     &0.1332790,0.1283971,0.1213205,0.1144493,0.1100211,
+     &0.1056500,0.0991218,0.0926120,0.0882538,0.0841548,
+     &0.0820158,0.0799326,0.0779781,0.0761736,0.0745909,
+     &0.0730158,0.0714981,0.0703739,0.0679849,0.0657191,
+     &0.0636815,0.0617775,0.0601208,0.0585010,0.0576308,
+     &0.0567537,0.0558357,0.0547788,0.0536580,0.0525378,
+     &0.0513812,0.0500444,0.0471741,0.0441685,0.0426759,
+     &0.0411515,0.0383862,0.0370815,0.0358252,0.0346632,
+     &0.0334926,0.0298874,0.0275405,0.0264717,0.0254866,
+     &0.0245280,0.0235218,0.0225007,0.0195162,0.0187928,
+     &0.0179918,0.0170857,0.0156065,0.0150664,0.0138279,
+     &0.0112556,0.0094019,0.0079691,0.0073517,0.0068074,
+     &0.0062553,0.0058107,0.0053889,0.0049634,0.0045574,
+     &0.0043685,0.0042020,0.0040541,0.0040013,0.0040349,
+     &0.0041445,0.0041994,0.0041524,0.0039878,0.0038609,
+     &0.0037426,0.0036932,0.0036563,0.0036177,0.0035376,
+     &0.0034454,0.0033390,0.0032297,0.0030226,0.0028803,
+     &0.0027832,0.0026872,0.0026783,0.0026373,0.0025813,
+     &0.0025507,0.0025227,0.0024990,0.0024694,0.0024103,
+     &0.0023370,0.0022120,0.0021112,0.0020491,0.0019000,
+     &0.0017298,0.0016389,0.0015661,0.0014226,0.0012886,
+     &0.0011617,0.0008021,0.0005148,0.0004169/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.02
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.02	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.02	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 2 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=5.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=2.e-6,qrefice=2.55)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0770404,2.1333470,2.4010422,2.4979005,3.0323684,
+     &3.1023693,1.8456773,0.6115797,1.2549678,1.4533914,
+     &1.6278559,1.7319367,1.8213371,1.9134820,2.0143185,
+     &2.1186094,2.2303414,2.3434513,2.4327984,2.4951937,
+     &2.5413978,2.5864980,2.6369226,2.6951535,2.7622788,
+     &2.8332534,2.8984516,2.9598370,3.0300596,3.0575798,
+     &3.0930560,3.1250999,3.1535439,3.1871719,3.2121134,
+     &3.2310603,3.2315695,3.2093773,3.1794426,3.1392601,
+     &3.0919006,2.9505072,2.7231605,2.6405320,2.5163631,
+     &2.3446450,2.1814499,2.0090101,1.8916085,1.8633907,
+     &1.8338290,1.8152963,1.8086077,1.8112632,1.8131738,
+     &1.7060630,1.5370420,1.4517928/
+       data epiceir/
+     &1.3677877,1.2895485,1.2393701,1.1429415,1.0560902,
+     &1.0034354,0.9967221,0.9962561,0.9977396,1.0125090,
+     &1.0341120,1.0880692,1.1033542,1.0976548,1.0879265,
+     &1.0804520,1.0700891,1.0510827,1.0297735,1.0111766,
+     &0.9773523,0.9594117,0.9459089,0.9159908,0.8764862,
+     &0.8542295,0.8300154,0.7979962,0.7717778,0.7486199,
+     &0.7285973,0.7015588,0.6676357,0.6260576,0.5785204,
+     &0.5338926,0.5080446,0.4684776,0.4333192,0.4139500,
+     &0.3915187,0.3532456,0.3098173,0.2878825,0.3012615,
+     &0.3171561,0.3421502,0.3891775,0.4544489,0.5433146,
+     &0.6361080,0.7489142,0.8315196,0.9866923,1.0865711,
+     &1.1662428,1.2104664,1.2263397,1.2011900,1.1775792,
+     &1.1506165,1.1109692,1.0695655,1.0244781,0.9760489,
+     &0.9209963,0.8573869,0.7222608,0.6077753,0.5570301,
+     &0.5179734,0.4515876,0.4286255,0.4101167,0.3839801,
+     &0.3538276,0.2605970,0.2226936,0.2192847,0.2094082,
+     &0.1883334,0.1602530,0.1354466,0.0878593,0.0806558,
+     &0.0747401,0.0696599,0.0635099,0.0620812,0.0608565,
+     &0.0708767,0.0859044,0.1087823,0.1332179,0.1678403,
+     &0.2047173,0.2441402,0.2811615,0.3213149,0.3657669,
+     &0.4021912,0.4198142,0.4433846,0.4508493,0.4361142,
+     &0.3870594,0.3401732,0.3004933,0.2788217,0.2592098,
+     &0.2339364,0.2185203,0.2035674,0.1773828,0.1576549,
+     &0.1412068,0.1290261,0.1220045,0.1392276,0.1544823,
+     &0.1700448,0.1902850,0.1939131,0.1865104,0.1808444,
+     &0.1743156,0.1667072,0.1563581,0.1424541,0.1275658,
+     &0.1140205,0.0962364,0.0843266,0.0779076,0.0582227,
+     &0.0489812,0.0453767,0.0424055,0.0373608,0.0329743,
+     &0.0294211,0.0211810,0.0134449,0.0103372/
+       data omegicevis/
+     &0.5456115,0.9999998,0.9999956,0.9999590,0.9916146,
+     &0.9859025,0.9887677,0.3030088,0.2913164,0.3281876,
+     &0.3529492,0.3651998,0.3768913,0.3895164,0.4031501,
+     &0.4161578,0.4291025,0.4413079,0.4489263,0.4537341,
+     &0.4575938,0.4624165,0.4686106,0.4772439,0.4906920,
+     &0.5103999,0.5342540,0.5620137,0.6054875,0.6363699,
+     &0.6767519,0.7208792,0.7611457,0.8031358,0.8346425,
+     &0.8628765,0.8866344,0.9024555,0.9187659,0.9315375,
+     &0.9414928,0.9542499,0.9594395,0.9604324,0.9575609,
+     &0.9427309,0.9280359,0.9029658,0.8663382,0.8482844,
+     &0.8309193,0.8149818,0.8138757,0.8108203,0.8191826,
+     &0.8778344,0.8991383,0.9015617/
+       data omegiceir/
+     &0.8934232,0.8818511,0.8737661,0.8382167,0.7786070,
+     &0.6939076,0.6735601,0.6493360,0.6269631,0.5988325,
+     &0.5805314,0.5477262,0.5506567,0.5654900,0.5726005,
+     &0.5761235,0.5833758,0.5930895,0.5978242,0.5985849,
+     &0.5960529,0.5830086,0.5764220,0.5759224,0.5773382,
+     &0.5725862,0.5723791,0.5748378,0.5679526,0.5619652,
+     &0.5570325,0.5608990,0.5682156,0.5793377,0.5887846,
+     &0.5845600,0.5571433,0.5294130,0.4933869,0.4654703,
+     &0.4418373,0.4019260,0.3476712,0.2847430,0.1985389,
+     &0.1588668,0.1246927,0.0997362,0.0880947,0.0885516,
+     &0.0949879,0.1061776,0.1158887,0.1351058,0.1506025,
+     &0.1648239,0.1789169,0.1923770,0.2058806,0.2128322,
+     &0.2198936,0.2270511,0.2336397,0.2410020,0.2492446,
+     &0.2583708,0.2685325,0.2880028,0.2994628,0.3033591,
+     &0.3015518,0.2984661,0.2927081,0.2880204,0.2918781,
+     &0.2983889,0.3187046,0.3071705,0.2860579,0.2815239,
+     &0.2940739,0.3184738,0.3403679,0.3687520,0.3625693,
+     &0.3473680,0.3237919,0.2777646,0.2580903,0.2082118,
+     &0.1032983,0.0523547,0.0255129,0.0169770,0.0125923,
+     &0.0104937,0.0098291,0.0097139,0.0098247,0.0101194,
+     &0.0108076,0.0114394,0.0123597,0.0134295,0.0146494,
+     &0.0156162,0.0159481,0.0155375,0.0147876,0.0145659,
+     &0.0146613,0.0148656,0.0152911,0.0160210,0.0162369,
+     &0.0162299,0.0157726,0.0147472,0.0112574,0.0095320,
+     &0.0086141,0.0081565,0.0082618,0.0086479,0.0087967,
+     &0.0089716,0.0091790,0.0094908,0.0098519,0.0101090,
+     &0.0102865,0.0104608,0.0105742,0.0106353,0.0118091,
+     &0.0111652,0.0106810,0.0103373,0.0095315,0.0087433,
+     &0.0078753,0.0051297,0.0033094,0.0028262/
+       data gicevis/
+     &0.9484491,0.8355189,0.7778400,0.7776268,0.8190585,
+     &0.8606436,0.8731218,0.8806872,0.8701044,0.8643763,
+     &0.8590536,0.8557699,0.8518856,0.8469009,0.8408017,
+     &0.8344239,0.8276296,0.8213363,0.8196754,0.8210629,
+     &0.8234175,0.8239279,0.8233964,0.8221809,0.8193476,
+     &0.8139911,0.8067252,0.7971323,0.7828836,0.7760382,
+     &0.7660869,0.7580626,0.7531731,0.7496098,0.7489922,
+     &0.7482402,0.7481378,0.7496041,0.7509772,0.7528265,
+     &0.7546561,0.7586707,0.7610235,0.7611462,0.7609918,
+     &0.7593807,0.7559055,0.7519168,0.7489015,0.7477896,
+     &0.7452020,0.7419832,0.7389061,0.7381128,0.7358862,
+     &0.7217935,0.7082421,0.7019699/
+       data giceir/
+     &0.6960046,0.6900042,0.6861350,0.6780239,0.6687398,
+     &0.6597540,0.6579545,0.6563612,0.6546398,0.6533316,
+     &0.6517801,0.6404516,0.6350707,0.6258222,0.6224794,
+     &0.6192569,0.6158453,0.6121228,0.6084902,0.6050581,
+     &0.5983168,0.5919929,0.5853947,0.5746408,0.5632364,
+     &0.5555539,0.5475681,0.5390213,0.5306059,0.5220675,
+     &0.5134400,0.5042357,0.4944685,0.4842367,0.4735520,
+     &0.4627753,0.4524445,0.4363809,0.4197907,0.4085655,
+     &0.3969283,0.3785424,0.3589033,0.3451340,0.3322701,
+     &0.3254838,0.3188725,0.3129705,0.3078346,0.3038980,
+     &0.3000817,0.2968043,0.2943990,0.2886447,0.2820266,
+     &0.2753667,0.2682444,0.2614060,0.2542432,0.2503684,
+     &0.2464747,0.2424094,0.2378109,0.2329219,0.2279974,
+     &0.2228620,0.2168691,0.2037218,0.1898008,0.1828437,
+     &0.1758485,0.1631169,0.1571932,0.1515194,0.1461390,
+     &0.1406711,0.1239195,0.1134407,0.1088622,0.1045607,
+     &0.1002667,0.0957376,0.0912288,0.0785050,0.0754995,
+     &0.0722006,0.0684929,0.0624823,0.0602997,0.0553188,
+     &0.0450513,0.0376778,0.0319985,0.0295693,0.0274262,
+     &0.0252342,0.0234632,0.0217670,0.0200484,0.0184050,
+     &0.0176370,0.0169397,0.0163182,0.0160728,0.0161649,
+     &0.0165620,0.0167632,0.0165711,0.0159091,0.0153961,
+     &0.0149173,0.0147177,0.0145685,0.0144148,0.0140963,
+     &0.0137293,0.0133060,0.0128724,0.0120525,0.0114887,
+     &0.0111030,0.0107191,0.0106819,0.0105141,0.0102884,
+     &0.0101648,0.0100523,0.0099577,0.0098403,0.0096062,
+     &0.0093154,0.0088192,0.0084187,0.0081718,0.0075791,
+     &0.0069006,0.0065386,0.0062486,0.0056770,0.0051429,
+     &0.0046372,0.0032037,0.0020571,0.0016664/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.03
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.03	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.03	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice: PARTICLE RADIUS = 3 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.5E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=3.e-6,qrefice=2.2)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0594757,2.0556829,2.2896707,2.3257456,2.5099661,
+     &2.9161227,2.8020720,0.9336269,1.5134708,1.6889371,
+     &1.8322314,1.9146321,1.9831489,2.0514481,2.1239402,
+     &2.1971617,2.2737679,2.3492715,2.4073563,2.4458375,
+     &2.4726937,2.4971056,2.5221505,2.5486584,2.5773935,
+     &2.6081295,2.6391418,2.6699214,2.7093878,2.7364888,
+     &2.7674158,2.8051183,2.8506889,2.9136717,2.9810331,
+     &3.0470915,3.0933173,3.1121876,3.1349294,3.1638598,
+     &3.1912117,3.2744172,3.2761116,3.2431061,3.2102768,
+     &3.1776469,3.0866187,2.9577594,2.8526461,2.8176398,
+     &2.7821639,2.7549253,2.7503767,2.7499533,2.7608297,
+     &2.7274404,2.5991304,2.5173609/
+       data epiceir/
+     &2.4190733,2.3199425,2.2540693,2.1095867,1.9555371,
+     &1.8269345,1.8036077,1.7855358,1.7711544,1.7690116,
+     &1.7829260,1.8295234,1.8549844,1.8687238,1.8656639,
+     &1.8619236,1.8579320,1.8448261,1.8235378,1.8017112,
+     &1.7578924,1.7259388,1.7054915,1.6687690,1.6185619,
+     &1.5858195,1.5535859,1.5112923,1.4703351,1.4347173,
+     &1.4047177,1.3697965,1.3251381,1.2680571,1.1960392,
+     &1.1172380,1.0578237,0.9745934,0.8949080,0.8474779,
+     &0.7968613,0.7102672,0.6077121,0.5407101,0.5224510,
+     &0.5266400,0.5439359,0.5927324,0.6681964,0.7765685,
+     &0.8902640,1.0280455,1.1302272,1.3228931,1.4579507,
+     &1.5726897,1.6591437,1.7202030,1.7452124,1.7473249,
+     &1.7453249,1.7290004,1.7075497,1.6815135,1.6501899,
+     &1.6082871,1.5523466,1.4047438,1.2489705,1.1717392,
+     &1.1052268,0.9884429,0.9432285,0.9081387,0.8657278,
+     &0.8152991,0.6394543,0.5499370,0.5321090,0.5103995,
+     &0.4716277,0.4179623,0.3657534,0.2508311,0.2299716,
+     &0.2108125,0.1924924,0.1673682,0.1598235,0.1464571,
+     &0.1420538,0.1533015,0.1798090,0.2135266,0.2636204,
+     &0.3173732,0.3756316,0.4310254,0.4916850,0.5594596,
+     &0.6165060,0.6480070,0.6899570,0.7094871,0.6969641,
+     &0.6295437,0.5589720,0.4951279,0.4591832,0.4279796,
+     &0.3880569,0.3635468,0.3400364,0.2975883,0.2645470,
+     &0.2365445,0.2152134,0.2020684,0.2264057,0.2488454,
+     &0.2725164,0.3044016,0.3105968,0.3001241,0.2917667,
+     &0.2818419,0.2701418,0.2540473,0.2319813,0.2079458,
+     &0.1858774,0.1567208,0.1371507,0.1266034,0.0947660,
+     &0.0791723,0.0730714,0.0680956,0.0596443,0.0523504,
+     &0.0464472,0.0328870,0.0206243,0.0157984/
+       data omegicevis/
+     &0.5478598,0.9999998,0.9999930,0.9999391,0.9852892,
+     &0.9747255,0.9896471,0.3921073,0.3646954,0.3975615,
+     &0.4174147,0.4264744,0.4352827,0.4448440,0.4550543,
+     &0.4644430,0.4733422,0.4809923,0.4836857,0.4835298,
+     &0.4823884,0.4821825,0.4822653,0.4822173,0.4828566,
+     &0.4861327,0.4930841,0.5041330,0.5267492,0.5471958,
+     &0.5780509,0.6176673,0.6584746,0.7053177,0.7443977,
+     &0.7823801,0.8173603,0.8434741,0.8708835,0.8929197,
+     &0.9106523,0.9344197,0.9465593,0.9499664,0.9501572,
+     &0.9384264,0.9281004,0.9095014,0.8796501,0.8642664,
+     &0.8496780,0.8360837,0.8353950,0.8325557,0.8399941,
+     &0.8961539,0.9191431,0.9229702/
+       data omegiceir/
+     &0.9181703,0.9106198,0.9053057,0.8796571,0.8349904,
+     &0.7679166,0.7511637,0.7306502,0.7113808,0.6862068,
+     &0.6691588,0.6380840,0.6405194,0.6548850,0.6619208,
+     &0.6655905,0.6727100,0.6823230,0.6875201,0.6890487,
+     &0.6883412,0.6776634,0.6725497,0.6736822,0.6769779,
+     &0.6740052,0.6752223,0.6791695,0.6745857,0.6706817,
+     &0.6675888,0.6726563,0.6810013,0.6928600,0.7032822,
+     &0.7016219,0.6788723,0.6561857,0.6251051,0.5999153,
+     &0.5784231,0.5407491,0.4858367,0.4156316,0.3081297,
+     &0.2542117,0.2051306,0.1674406,0.1491730,0.1494159,
+     &0.1588227,0.1749455,0.1886469,0.2149218,0.2356885,
+     &0.2543647,0.2729447,0.2907736,0.3091933,0.3188552,
+     &0.3287012,0.3389443,0.3486176,0.3593718,0.3712797,
+     &0.3844498,0.3992367,0.4283787,0.4480617,0.4557256,
+     &0.4565090,0.4582297,0.4537602,0.4503480,0.4573702,
+     &0.4677775,0.5004078,0.4921789,0.4687816,0.4652704,
+     &0.4829984,0.5146720,0.5423340,0.5802344,0.5751773,
+     &0.5603711,0.5358865,0.4843219,0.4606548,0.3958648,
+     &0.2311990,0.1309277,0.0689810,0.0473044,0.0357645,
+     &0.0302096,0.0285216,0.0283661,0.0288575,0.0298694,
+     &0.0319034,0.0337869,0.0364643,0.0395041,0.0429032,
+     &0.0455614,0.0464966,0.0454506,0.0435048,0.0429859,
+     &0.0433492,0.0439662,0.0451907,0.0472841,0.0479729,
+     &0.0480491,0.0468699,0.0440733,0.0341798,0.0291907,
+     &0.0265080,0.0251720,0.0254859,0.0266501,0.0271129,
+     &0.0276442,0.0282702,0.0292041,0.0302890,0.0310830,
+     &0.0316508,0.0322409,0.0326373,0.0328552,0.0364115,
+     &0.0346299,0.0332475,0.0322650,0.0299256,0.0276080,
+     &0.0250169,0.0166050,0.0108650,0.0093190/
+       data gicevis/
+     &0.9487292,0.8501517,0.8084917,0.8064129,0.7796354,
+     &0.8265753,0.9093526,0.9365674,0.9241107,0.9169607,
+     &0.9102123,0.9061169,0.9015271,0.8957432,0.8886193,
+     &0.8810557,0.8728880,0.8651341,0.8625306,0.8636174,
+     &0.8661903,0.8671943,0.8675743,0.8681570,0.8683062,
+     &0.8662376,0.8610609,0.8520109,0.8346523,0.8228595,
+     &0.8053397,0.7876619,0.7732534,0.7589003,0.7500000,
+     &0.7413471,0.7345427,0.7344642,0.7366309,0.7405840,
+     &0.7467821,0.7644036,0.7784136,0.7846442,0.7965618,
+     &0.8083032,0.8136568,0.8199432,0.8255728,0.8271201,
+     &0.8275242,0.8268972,0.8249819,0.8245324,0.8223208,
+     &0.8117355,0.8062472,0.8041336/
+       data giceir/
+     &0.8028125,0.8016422,0.8009415,0.7998557,0.7981417,
+     &0.7963558,0.7960360,0.7959067,0.7956044,0.7956340,
+     &0.7950525,0.7882976,0.7844244,0.7777230,0.7753325,
+     &0.7731695,0.7707492,0.7681598,0.7659332,0.7639940,
+     &0.7603320,0.7571294,0.7533165,0.7466281,0.7393790,
+     &0.7345678,0.7292926,0.7235673,0.7182128,0.7126561,
+     &0.7069229,0.7005080,0.6936766,0.6865230,0.6792384,
+     &0.6722496,0.6657850,0.6547473,0.6428918,0.6345846,
+     &0.6255974,0.6109424,0.5946515,0.5828903,0.5715944,
+     &0.5652506,0.5587830,0.5527261,0.5470884,0.5424237,
+     &0.5377048,0.5334029,0.5303385,0.5231666,0.5153511,
+     &0.5072109,0.4983860,0.4895755,0.4802338,0.4751357,
+     &0.4699576,0.4646551,0.4586791,0.4522615,0.4457387,
+     &0.4389421,0.4309897,0.4133823,0.3940207,0.3839259,
+     &0.3734751,0.3533985,0.3436313,0.3339687,0.3244507,
+     &0.3145035,0.2824177,0.2612788,0.2519038,0.2428105,
+     &0.2333613,0.2230495,0.2126012,0.1826718,0.1755434,
+     &0.1677177,0.1589084,0.1445894,0.1393903,0.1275548,
+     &0.1034226,0.0862908,0.0732680,0.0678129,0.0630464,
+     &0.0581228,0.0541460,0.0502856,0.0463469,0.0425679,
+     &0.0408138,0.0391414,0.0376537,0.0370017,0.0370768,
+     &0.0378109,0.0381619,0.0376564,0.0360912,0.0348694,
+     &0.0337249,0.0332462,0.0328845,0.0325112,0.0317704,
+     &0.0309227,0.0299524,0.0289665,0.0271364,0.0258780,
+     &0.0250178,0.0241542,0.0240672,0.0236685,0.0231454,
+     &0.0228576,0.0225964,0.0223764,0.0221073,0.0215770,
+     &0.0209200,0.0198007,0.0188984,0.0183424,0.0170089,
+     &0.0154822,0.0146694,0.0140185,0.0127366,0.0115393,
+     &0.0104058,0.0071931,0.0046216,0.0037448/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.04
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.04	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.04	(revision 46)
@@ -0,0 +1,199 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 4 MICRONS (Franck Montmessin)
+
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=2.1E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=4.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1802000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8197000E-05,
+     &.8333000E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680000E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0854822,2.0504486,2.2594056,2.2905577,2.4309553,
+     &2.7394925,2.9738858,1.0479889,1.5827071,1.7473683,
+     &1.8791661,1.9542847,2.0162247,2.0774747,2.1420606,
+     &2.2070080,2.2746674,2.3410056,2.3915425,2.4243052,
+     &2.4465380,2.4664531,2.4864873,2.5070593,2.5285199,
+     &2.5506347,2.5724538,2.5936350,2.6196233,2.6374214,
+     &2.6572831,2.6830637,2.7173599,2.7675186,2.8233521,
+     &2.8801521,2.9195511,2.9341195,2.9565225,2.9903221,
+     &3.0211312,3.1489194,3.2117107,3.1927426,3.1992998,
+     &3.2346768,3.1870882,3.0997686,3.0240328,2.9942008,
+     &2.9638598,2.9380857,2.9347956,2.9330930,2.9452588,
+     &2.9445502,2.8607601,2.7946008/
+       data epiceir/
+     &2.7047184,2.6120941,2.5504249,2.4083079,2.2449776,
+     &2.0963051,2.0678715,2.0435539,2.0233198,2.0134084,
+     &2.0220503,2.0596078,2.0865511,2.1071296,2.1073430,
+     &2.1056444,2.1049262,2.0960135,2.0772534,2.0565253,
+     &2.0132797,1.9785371,1.9572351,1.9217145,1.8724474,
+     &1.8385008,1.8061319,1.7637404,1.7201956,1.6824483,
+     &1.6508880,1.6160781,1.5712145,1.5128543,1.4363862,
+     &1.3483616,1.2774042,1.1795400,1.0840162,1.0261202,
+     &0.9651563,0.8602540,0.7339102,0.6469975,0.6119478,
+     &0.6091090,0.6207982,0.6672347,0.7434798,0.8558041,
+     &0.9740046,1.1170480,1.2233814,1.4233819,1.5659507,
+     &1.6880697,1.7848208,1.8579589,1.8989074,1.9101462,
+     &1.9175409,1.9114984,1.8998538,1.8840935,1.8632078,
+     &1.8316492,1.7857095,1.6508096,1.4954219,1.4151742,
+     &1.3432500,1.2148845,1.1631782,1.1234219,1.0776615,
+     &1.0225006,0.8207632,0.7104143,0.6854881,0.6592867,
+     &0.6146109,0.5515194,0.4878044,0.3406532,0.3125988,
+     &0.2862523,0.2605937,0.2247351,0.2136279,0.1929169,
+     &0.1780802,0.1848382,0.2104575,0.2466988,0.3018862,
+     &0.3613543,0.4261933,0.4881637,0.5562663,0.6325883,
+     &0.6974163,0.7349945,0.7849246,0.8107314,0.8016415,
+     &0.7301529,0.6518985,0.5788133,0.5371399,0.5015947,
+     &0.4561899,0.4281780,0.4014403,0.3523277,0.3134494,
+     &0.2802024,0.2545224,0.2382317,0.2645295,0.2893848,
+     &0.3160831,0.3526863,0.3600670,0.3487748,0.3395592,
+     &0.3284123,0.3151843,0.2968681,0.2714744,0.2435622,
+     &0.2178014,0.1836341,0.1606565,0.1482674,0.1111388,
+     &0.0925535,0.0852699,0.0793584,0.0693137,0.0606733,
+     &0.0536815,0.0376899,0.0234903,0.0179599/
+       data omegicevis/
+     &0.9997557,0.9999997,0.9999922,0.9999319,0.9834057,
+     &0.9697400,0.9889413,0.4170863,0.3839164,0.4148017,
+     &0.4329225,0.4410049,0.4489707,0.4576899,0.4670268,
+     &0.4755634,0.4835813,0.4903115,0.4920676,0.4910262,
+     &0.4890484,0.4880903,0.4873634,0.4862187,0.4850952,
+     &0.4856144,0.4890416,0.4960548,0.5125623,0.5285751,
+     &0.5546114,0.5898761,0.6277213,0.6730058,0.7122949,
+     &0.7517495,0.7888858,0.8171780,0.8476295,0.8725174,
+     &0.8933310,0.9217324,0.9365012,0.9409229,0.9421082,
+     &0.9300490,0.9206304,0.9031980,0.8741305,0.8588691,
+     &0.8445156,0.8310569,0.8304268,0.8275097,0.8349118,
+     &0.8934678,0.9187520,0.9234176/
+       data omegiceir/
+     &0.9195789,0.9130654,0.9084498,0.8848193,0.8432430,
+     &0.7802753,0.7644560,0.7449288,0.7265303,0.7022048,
+     &0.6854911,0.6547806,0.6568891,0.6708937,0.6778638,
+     &0.6815536,0.6886025,0.6981948,0.7035849,0.7054032,
+     &0.7053613,0.6954878,0.6908569,0.6925153,0.6964372,
+     &0.6940646,0.6957520,0.7002053,0.6964250,0.6932367,
+     &0.6907555,0.6961634,0.7047681,0.7167735,0.7274370,
+     &0.7265938,0.7055041,0.6847062,0.6557705,0.6320110,
+     &0.6117497,0.5758710,0.5225218,0.4523725,0.3413817,
+     &0.2842636,0.2313632,0.1900614,0.1697527,0.1697629,
+     &0.1798291,0.1970501,0.2115807,0.2391071,0.2606377,
+     &0.2798113,0.2988472,0.3170983,0.3361139,0.3461500,
+     &0.3563966,0.3671677,0.3774159,0.3888194,0.4014468,
+     &0.4154617,0.4312829,0.4628420,0.4848666,0.4936416,
+     &0.4953880,0.4988511,0.4951004,0.4923347,0.5001683,
+     &0.5114973,0.5471412,0.5407871,0.5179877,0.5151565,
+     &0.5338754,0.5665359,0.5949027,0.6346611,0.6304472,
+     &0.6168448,0.5937971,0.5441191,0.5208242,0.4555555,
+     &0.2795748,0.1643928,0.0891554,0.0618627,0.0471263,
+     &0.0400198,0.0378990,0.0377831,0.0385226,0.0399469,
+     &0.0426608,0.0451856,0.0487382,0.0527340,0.0571690,
+     &0.0606253,0.0618599,0.0605589,0.0581096,0.0574950,
+     &0.0580301,0.0588644,0.0604849,0.0632511,0.0642014,
+     &0.0643580,0.0628783,0.0592713,0.0462856,0.0396805,
+     &0.0361116,0.0343350,0.0347561,0.0363269,0.0369600,
+     &0.0376791,0.0385242,0.0397799,0.0412408,0.0423222,
+     &0.0431063,0.0439387,0.0445039,0.0448168,0.0496150,
+     &0.0473067,0.0454896,0.0441976,0.0410999,0.0380139,
+     &0.0345402,0.0231292,0.0152373,0.0130964/
+       data gicevis/
+     &0.8343501,0.8539270,0.8165237,0.8181057,0.7824335,
+     &0.8121903,0.9116917,0.9469896,0.9339413,0.9264918,
+     &0.9194773,0.9152379,0.9105224,0.9045991,0.8973010,
+     &0.8895398,0.8811479,0.8731629,0.8704250,0.8714981,
+     &0.8741569,0.8753158,0.8759663,0.8770830,0.8782619,
+     &0.8777608,0.8743001,0.8669701,0.8513806,0.8396250,
+     &0.8215540,0.8018272,0.7843039,0.7655624,0.7525014,
+     &0.7398580,0.7289740,0.7259218,0.7254756,0.7268577,
+     &0.7324639,0.7521768,0.7661537,0.7739922,0.7902248,
+     &0.8065580,0.8156578,0.8255079,0.8347661,0.8373555,
+     &0.8387650,0.8389051,0.8371919,0.8368247,0.8344242,
+     &0.8242407,0.8213838,0.8203836/
+       data giceir/
+     &0.8202859,0.8204761,0.8207446,0.8218899,0.8224330,
+     &0.8225752,0.8226243,0.8228495,0.8228806,0.8232125,
+     &0.8228349,0.8170514,0.8134916,0.8073353,0.8051527,
+     &0.8032251,0.8010219,0.7986862,0.7967891,0.7952084,
+     &0.7923052,0.7898931,0.7867939,0.7811755,0.7750518,
+     &0.7710254,0.7664988,0.7615658,0.7570799,0.7523895,
+     &0.7475237,0.7419846,0.7361146,0.7300106,0.7239206,
+     &0.7182872,0.7132332,0.7041776,0.6943774,0.6874813,
+     &0.6799427,0.6676864,0.6541361,0.6444608,0.6352317,
+     &0.6299193,0.6244130,0.6191449,0.6140400,0.6095717,
+     &0.6048778,0.6003752,0.5971281,0.5896495,0.5818252,
+     &0.5736867,0.5649501,0.5561939,0.5469384,0.5418788,
+     &0.5367152,0.5314598,0.5255540,0.5191799,0.5126669,
+     &0.5058801,0.4979611,0.4805868,0.4616396,0.4517272,
+     &0.4414385,0.4213243,0.4114112,0.4014477,0.3914565,
+     &0.3809337,0.3465430,0.3234292,0.3130346,0.3027512,
+     &0.2918884,0.2798819,0.2676042,0.2318030,0.2231267,
+     &0.2135321,0.2026399,0.1847338,0.1781789,0.1631734,
+     &0.1323553,0.1103728,0.0936858,0.0867514,0.0807283,
+     &0.0744888,0.0694563,0.0645469,0.0595233,0.0546962,
+     &0.0524681,0.0503008,0.0483757,0.0475037,0.0475338,
+     &0.0483772,0.0487606,0.0480684,0.0460275,0.0444297,
+     &0.0429296,0.0423003,0.0418224,0.0413265,0.0403650,
+     &0.0392690,0.0380197,0.0367560,0.0344374,0.0328447,
+     &0.0317576,0.0306637,0.0305520,0.0300328,0.0293586,
+     &0.0289865,0.0286487,0.0283637,0.0280170,0.0273389,
+     &0.0265009,0.0250756,0.0239277,0.0232211,0.0215270,
+     &0.0195894,0.0185593,0.0177348,0.0161119,0.0145967,
+     &0.0131628,0.0091000,0.0058481,0.0047391/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.05
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.05	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.05	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 5 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=1.2E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=5.e-6,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0428143,2.0440466,2.1968415,2.2153285,2.2960923,
+     &2.3659375,2.8867066,1.4714612,1.7771624,1.8997087,
+     &1.9929919,2.0451753,2.0872736,2.1281450,2.1707144,
+     &2.2132783,2.2573934,2.3003073,2.3321264,2.3514304,
+     &2.3634045,2.3739398,2.3842189,2.3941483,2.4037600,
+     &2.4129043,2.4213498,2.4291728,2.4373298,2.4419029,
+     &2.4471161,2.4538815,2.4630349,2.4742622,2.4854822,
+     &2.5033839,2.5176528,2.5136092,2.5134516,2.5263309,
+     &2.5060482,2.6094491,2.6798794,2.6632533,2.7183650,
+     &2.8463554,2.9012349,2.9348140,2.9701750,2.9754398,
+     &2.9789634,2.9716895,2.9712498,2.9672985,2.9738250,
+     &3.0348940,3.1332080,3.1466768/
+       data epiceir/
+     &3.1348512,3.1135170,3.0980451,3.0516498,2.9460745,
+     &2.7977514,2.7647121,2.7296543,2.6980081,2.6652355,
+     &2.6520360,2.6446781,2.6661332,2.7014117,2.7124405,
+     &2.7181728,2.7285180,2.7372139,2.7347012,2.7262812,
+     &2.7032161,2.6736920,2.6591630,2.6453030,2.6226292,
+     &2.5987844,2.5791478,2.5533869,2.5169418,2.4857807,
+     &2.4605293,2.4401815,2.4123871,2.3720129,2.3076501,
+     &2.2154198,2.1208081,1.9929006,1.8554076,1.7655714,
+     &1.6732348,1.5088136,1.2957467,1.1248519,1.0043060,
+     &0.9623911,0.9399940,0.9638529,1.0305194,1.1452191,
+     &1.2687433,1.4178077,1.5291764,1.7348669,1.8864686,
+     &2.0165479,2.1304126,2.2267041,2.3057120,2.3408694,
+     &2.3737895,2.3992765,2.4196458,2.4389904,2.4559703,
+     &2.4664493,2.4680557,2.4285460,2.3429909,2.2869768,
+     &2.2235444,2.0965919,2.0351093,1.9889221,1.9465162,
+     &1.8934352,1.6640973,1.4980435,1.4440260,1.4054043,
+     &1.3498148,1.2628263,1.1601040,0.8777069,0.8140609,
+     &0.7497768,0.6831331,0.5837339,0.5504547,0.4820068,
+     &0.3904156,0.3576854,0.3641066,0.4038780,0.4747776,
+     &0.5532535,0.6412786,0.7272216,0.8227299,0.9304959,
+     &1.0245264,1.0890912,1.1736258,1.2312673,1.2493920,
+     &1.1830822,1.0889487,0.9851518,0.9227560,0.8740039,
+     &0.8118621,0.7720758,0.7351863,0.6589684,0.5922329,
+     &0.5316939,0.4811391,0.4445072,0.4707272,0.5020384,
+     &0.5401840,0.5982011,0.6122363,0.6017624,0.5915391,
+     &0.5768967,0.5586212,0.5319895,0.4920566,0.4455049,
+     &0.4009319,0.3399382,0.2980777,0.2753274,0.2093637,
+     &0.1716706,0.1567566,0.1449283,0.1247388,0.1076142,
+     &0.0937344,0.0625980,0.0375503,0.0283737/
+       data omegicevis/
+     &0.5494931,0.9999998,0.9999893,0.9999013,0.9758908,
+     &0.9520350,0.9813806,0.4902175,0.4373621,0.4608643,
+     &0.4736899,0.4790656,0.4847680,0.4913164,0.4985126,
+     &0.5050762,0.5111622,0.5159741,0.5158814,0.5132105,
+     &0.5098287,0.5077458,0.5059724,0.5035798,0.5004508,
+     &0.4974112,0.4955608,0.4956980,0.4999822,0.5055479,
+     &0.5182787,0.5389499,0.5644807,0.6003360,0.6358722,
+     &0.6744935,0.7115463,0.7406379,0.7754455,0.8046825,
+     &0.8330303,0.8720050,0.8909805,0.8971584,0.8986517,
+     &0.8775966,0.8676537,0.8459433,0.8139567,0.7968134,
+     &0.7813268,0.7666911,0.7660663,0.7625950,0.7705110,
+     &0.8471078,0.8871527,0.8974949/
+       data omegiceir/
+     &0.8977836,0.8945748,0.8924134,0.8738061,0.8388449,
+     &0.7859417,0.7726671,0.7557423,0.7397608,0.7176195,
+     &0.7014517,0.6706539,0.6709267,0.6829631,0.6896477,
+     &0.6933964,0.7002523,0.7101147,0.7166997,0.7200235,
+     &0.7232453,0.7166191,0.7139632,0.7179898,0.7246478,
+     &0.7245268,0.7280882,0.7347864,0.7340991,0.7336202,
+     &0.7333983,0.7403341,0.7504411,0.7639143,0.7766036,
+     &0.7794099,0.7640404,0.7500795,0.7291497,0.7110402,
+     &0.6959369,0.6683127,0.6242461,0.5602421,0.4472759,
+     &0.3841803,0.3222430,0.2709396,0.2443090,0.2429399,
+     &0.2540719,0.2731242,0.2887707,0.3170114,0.3380532,
+     &0.3559635,0.3733418,0.3897057,0.4070157,0.4162955,
+     &0.4258323,0.4362862,0.4465349,0.4581154,0.4711562,
+     &0.4861186,0.5037051,0.5414228,0.5708696,0.5832593,
+     &0.5885317,0.5983726,0.5977412,0.5976148,0.6077798,
+     &0.6216503,0.6655161,0.6657503,0.6467597,0.6461229,
+     &0.6660358,0.6987826,0.7269489,0.7691699,0.7678677,
+     &0.7591690,0.7429094,0.7052954,0.6864988,0.6300915,
+     &0.4480666,0.2989470,0.1806929,0.1314649,0.1033070,
+     &0.0896708,0.0859415,0.0864679,0.0888946,0.0928023,
+     &0.0989119,0.1047399,0.1125751,0.1210458,0.1301845,
+     &0.1373109,0.1401302,0.1382077,0.1341803,0.1336529,
+     &0.1354927,0.1375671,0.1411836,0.1473035,0.1498776,
+     &0.1508872,0.1485618,0.1416996,0.1143930,0.0999223,
+     &0.0919109,0.0879268,0.0889088,0.0927174,0.0943725,
+     &0.0961518,0.0982119,0.1012073,0.1047162,0.1074747,
+     &0.1096113,0.1120945,0.1138527,0.1148487,0.1264241,
+     &0.1220450,0.1182757,0.1155932,0.1089078,0.1020501,
+     &0.0940495,0.0660757,0.0452682,0.0393932/
+       data gicevis/
+     &0.9488561,0.8622694,0.8421568,0.8444307,0.8198477,
+     &0.8025251,0.8924177,0.9702666,0.9557836,0.9476732,
+     &0.9401344,0.9356233,0.9306720,0.9244909,0.9168691,
+     &0.9087364,0.8999177,0.8914922,0.8885176,0.8896047,
+     &0.8924723,0.8939612,0.8951342,0.8972442,0.9004632,
+     &0.9036172,0.9051868,0.9042581,0.8988889,0.8931115,
+     &0.8817939,0.8662245,0.8491337,0.8268852,0.8078062,
+     &0.7890281,0.7693759,0.7548954,0.7426000,0.7296526,
+     &0.7270693,0.7355062,0.7289565,0.7364469,0.7544447,
+     &0.7692665,0.7925164,0.8065700,0.8307455,0.8377706,
+     &0.8427537,0.8454301,0.8436610,0.8436959,0.8396172,
+     &0.8239458,0.8273445,0.8320904/
+       data giceir/
+     &0.8373514,0.8419112,0.8460672,0.8574966,0.8670993,
+     &0.8753594,0.8769836,0.8787410,0.8801410,0.8817471,
+     &0.8821138,0.8790489,0.8760744,0.8707907,0.8689077,
+     &0.8674014,0.8654746,0.8634583,0.8622014,0.8614331,
+     &0.8604119,0.8602243,0.8590601,0.8563642,0.8534315,
+     &0.8516557,0.8491830,0.8464145,0.8443506,0.8419912,
+     &0.8393673,0.8359801,0.8324290,0.8288801,0.8258969,
+     &0.8241146,0.8232231,0.8199658,0.8160087,0.8130227,
+     &0.8095026,0.8040639,0.7986902,0.7954774,0.7927923,
+     &0.7908941,0.7887109,0.7863154,0.7833571,0.7799240,
+     &0.7757225,0.7708758,0.7671629,0.7589634,0.7514880,
+     &0.7439123,0.7363079,0.7288431,0.7213242,0.7172369,
+     &0.7129840,0.7087308,0.7039406,0.6985872,0.6929027,
+     &0.6868637,0.6798444,0.6653367,0.6513552,0.6442967,
+     &0.6372020,0.6223192,0.6148563,0.6068394,0.5979654,
+     &0.5884917,0.5583712,0.5388037,0.5299017,0.5197192,
+     &0.5079988,0.4946542,0.4810905,0.4402598,0.4297767,
+     &0.4177190,0.4033195,0.3778822,0.3680294,0.3443614,
+     &0.2904477,0.2472555,0.2122748,0.1975763,0.1849724,
+     &0.1717572,0.1611385,0.1505969,0.1396510,0.1290195,
+     &0.1242519,0.1192575,0.1148210,0.1125826,0.1120808,
+     &0.1130957,0.1133712,0.1114241,0.1063793,0.1023448,
+     &0.0985022,0.0968736,0.0956093,0.0943082,0.0919330,
+     &0.0892278,0.0861601,0.0830894,0.0777779,0.0741764,
+     &0.0717541,0.0693096,0.0690498,0.0677189,0.0660590,
+     &0.0651242,0.0642725,0.0635431,0.0626790,0.0610575,
+     &0.0590792,0.0557436,0.0530752,0.0514414,0.0475330,
+     &0.0431135,0.0407930,0.0389434,0.0353244,0.0319652,
+     &0.0288019,0.0198931,0.0127889,0.0103672/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.10
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.10	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aerice.h.10	(revision 46)
@@ -0,0 +1,198 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'aerice.h'
+c Spectral  Radiative properties of water ice PARTICLE RADIUS = 10 MICRONS (Franck Montmessin)
+c (Warren, 1984)
+
+c visible 
+      integer nicevis
+      parameter(nicevis=58)
+      REAL longicevis(nicevis),epicevis(nicevis)
+     &    ,omegicevis(nicevis),gicevis(nicevis)
+
+
+c IR 
+      integer niceir
+      parameter(niceir=144)
+      REAL longiceir(niceir),epiceir(niceir)
+     &    ,omegiceir(niceir),giceir(niceir)
+
+c Ratio solsirice = Tau(vis) / Tau (9 microns)
+      REAL solsirice
+      PARAMETER (solsirice=0.8E+0)
+c Optical properties used by initracer.F to determine Qextrhor
+      REAL rcrystal,qrefice
+      PARAMETER (rcrystal=1.e-5,qrefice=2.1)
+c---------------------------------------------------------------------
+	     
+       data longicevis/
+     &.1033000E-06,.4000000E-06,.8000000E-06,.1000000E-05,.1504000E-05,
+     &.2000000E-05,.2600000E-05,.2817000E-05,.2899000E-05,.2915000E-05,
+     &.2933000E-05,.2950000E-05,.2967000E-05,.2985000E-05,.3003000E-05,
+     &.3021000E-05,.3040000E-05,.3058000E-05,.3077000E-05,.3096000E-05,
+     &.3115000E-05,.3135000E-05,.3155000E-05,.3175000E-05,.3195000E-05,
+     &.3215000E-05,.3236000E-05,.3257000E-05,.3279000E-05,.3300000E-05,
+     &.3322000E-05,.3345000E-05,.3367000E-05,.3390000E-05,.3413000E-05,
+     &.3436000E-05,.3460000E-05,.3484000E-05,.3509000E-05,.3534000E-05,
+     &.3559000E-05,.3624000E-05,.3732000E-05,.3775000E-05,.3847000E-05,
+     &.3969000E-05,.4099000E-05,.4239000E-05,.4348000E-05,.4387000E-05,
+     &.4444000E-05,.4505000E-05,.4547000E-05,.4560000E-05,.4580000E-05,
+     &.4719000E-05,.4904000E-05,.5000000E-05/
+       data longiceir/
+     &.5100000E-05,.5200000E-05,.5263000E-05,.5400000E-05,.5556000E-05,
+     &.5714000E-05,.5747000E-05,.5780000E-05,.5814000E-05,.5848000E-05,
+     &.5882000E-05,.6061000E-05,.6135000E-05,.6250000E-05,.6289000E-05,
+     &.6329000E-05,.6369000E-05,.6410000E-05,.6452000E-05,.6494000E-05,
+     &.6579000E-05,.6667000E-05,.6757000E-05,.6897000E-05,.7042000E-05,
+     &.7143000E-05,.7246000E-05,.7353000E-05,.7463000E-05,.7576000E-05,
+     &.7692000E-05,.7812000E-05,.7937000E-05,.8065000E-05,.8196999E-05,
+     &.8333001E-05,.8475000E-05,.8696000E-05,.8929000E-05,.9091000E-05,
+     &.9259000E-05,.9524000E-05,.9804000E-05,.1000000E-04,.1020000E-04,
+     &.1031000E-04,.1042000E-04,.1053000E-04,.1064000E-04,.1075000E-04,
+     &.1087000E-04,.1100000E-04,.1111000E-04,.1136000E-04,.1163000E-04,
+     &.1190000E-04,.1220000E-04,.1250000E-04,.1282000E-04,.1299000E-04,
+     &.1316000E-04,.1333000E-04,.1351000E-04,.1370000E-04,.1389000E-04,
+     &.1408000E-04,.1429000E-04,.1471000E-04,.1515000E-04,.1538000E-04,
+     &.1563000E-04,.1613000E-04,.1639000E-04,.1667000E-04,.1695000E-04,
+     &.1724000E-04,.1818000E-04,.1887000E-04,.1923000E-04,.1961000E-04,
+     &.2000000E-04,.2041000E-04,.2083000E-04,.2222000E-04,.2260000E-04,
+     &.2305000E-04,.2360000E-04,.2460000E-04,.2500000E-04,.2600000E-04,
+     &.2857000E-04,.3100000E-04,.3333000E-04,.3448000E-04,.3564000E-04,
+     &.3700000E-04,.3824000E-04,.3960000E-04,.4114000E-04,.4276000E-04,
+     &.4358000E-04,.4458000E-04,.4550000E-04,.4615000E-04,.4671000E-04,
+     &.4736000E-04,.4800000E-04,.4878000E-04,.5003000E-04,.5128000E-04,
+     &.5275000E-04,.5350000E-04,.5424000E-04,.5500000E-04,.5574000E-04,
+     &.5640000E-04,.5700000E-04,.5746000E-04,.5840000E-04,.5929000E-04,
+     &.6000000E-04,.6100000E-04,.6125000E-04,.6250000E-04,.6378000E-04,
+     &.6467000E-04,.6558000E-04,.6655000E-04,.6760000E-04,.6900000E-04,
+     &.7053000E-04,.7300000E-04,.7500000E-04,.7629000E-04,.8000000E-04,
+     &.8297000E-04,.8500000E-04,.8680001E-04,.9080000E-04,.9517000E-04,
+     &.1000000E-03,.1200000E-03,.1500000E-03,.1670000E-03/
+       data epicevis/
+     &2.0273049,2.0553651,2.1324184,2.1634929,2.1279089,
+     &2.2649884,2.2698500,2.0945108,1.9718964,2.0290234,
+     &2.0724838,2.0969706,2.1164510,2.1352997,2.1550443,
+     &2.1750197,2.1959615,2.2164886,2.2313924,2.2397768,
+     &2.2443697,2.2484777,2.2524328,2.2560196,2.2593305,
+     &2.2624981,2.2655437,2.2686977,2.2731700,2.2766244,
+     &2.2794294,2.2792618,2.2795415,2.2846086,2.2950807,
+     &2.3121541,2.3191226,2.3011398,2.2936110,2.2905064,
+     &2.2727025,2.3178666,2.3242922,2.3330655,2.3261759,
+     &2.3501878,2.3524554,2.3359809,2.3611195,2.3675768,
+     &2.3733923,2.3748493,2.3755083,2.3754752,2.3756132,
+     &2.3760719,2.4271755,2.3955469/
+       data epiceir/
+     &2.4612815,2.4641292,2.4568148,2.5147929,2.5530331,
+     &2.5705762,2.5728459,2.5721469,2.5704122,2.5617049,
+     &2.5519185,2.5355358,2.5353646,2.5456607,2.5519402,
+     &2.5570130,2.5640745,2.5747874,2.5854921,2.5940452,
+     &2.6071377,2.6118498,2.6188061,2.6403730,2.6669781,
+     &2.6775784,2.6885033,2.7046711,2.7192614,2.7353652,
+     &2.7494493,2.7692459,2.7941475,2.8259096,2.8570986,
+     &2.8766527,2.8766177,2.8746240,2.8368504,2.7997968,
+     &2.7614427,2.6663651,2.4818733,2.2510304,1.9602349,
+     &1.8146522,1.6854036,1.6102730,1.6048870,1.6705624,
+     &1.7576077,1.8667697,1.9497169,2.0947831,2.2019422,
+     &2.2885010,2.3667836,2.4332867,2.4948113,2.5246017,
+     &2.5532246,2.5817444,2.6085849,2.6368368,2.6661391,
+     &2.6972022,2.7322018,2.8090558,2.8837960,2.9189849,
+     &2.9399867,2.9627054,2.9581554,2.9556482,2.9702957,
+     &2.9914343,3.0622592,3.0227430,2.9683504,2.9483757,
+     &2.9425662,2.9222951,2.8775811,2.6872020,2.5973134,
+     &2.4775703,2.3277271,2.0808144,1.9930708,1.7932411,
+     &1.3749977,1.1105362,0.9519616,0.9414314,1.0029964,
+     &1.0884044,1.1978686,1.3110209,1.4375935,1.5781999,
+     &1.7028408,1.8087940,1.9384904,2.0478878,2.1342847,
+     &2.1552835,2.1219630,2.0431452,1.9908499,1.9683007,
+     &1.9452211,1.9265127,1.9173379,1.8556699,1.7696880,
+     &1.6679885,1.5544487,1.4389187,1.3726599,1.3709559,
+     &1.4067492,1.4992472,1.5341307,1.5684799,1.5883886,
+     &1.5933384,1.5931257,1.5828085,1.5444956,1.4816657,
+     &1.4080117,1.2855885,1.1866654,1.1282085,0.9652229,
+     &0.7942671,0.7229686,0.6674553,0.5672902,0.4800995,
+     &0.4058672,0.2359050,0.1220444,0.0873671/
+       data omegicevis/
+     &0.5504259,0.9999992,0.9999804,0.9997928,0.9548051,
+     &0.9126351,0.9571041,0.5516225,0.4932337,0.5069626,
+     &0.5145947,0.5177403,0.5216092,0.5264726,0.5321194,
+     &0.5374104,0.5423936,0.5462285,0.5453517,0.5420842,
+     &0.5383082,0.5359790,0.5340598,0.5316239,0.5284724,
+     &0.5251024,0.5221875,0.5200486,0.5182305,0.5173715,
+     &0.5181928,0.5213331,0.5280793,0.5438614,0.5659477,
+     &0.5936272,0.6220001,0.6461561,0.6788177,0.7087492,
+     &0.7393658,0.7893919,0.8146747,0.8209112,0.8149179,
+     &0.7802355,0.7582701,0.7185146,0.6685008,0.6464375,
+     &0.6278486,0.6119440,0.6113081,0.6078985,0.6163179,
+     &0.7056757,0.7598560,0.7761379/
+       data omegiceir/
+     &0.7759839,0.7669778,0.7639439,0.7364159,0.6928631,
+     &0.6428539,0.6326926,0.6199911,0.6088360,0.5931817,
+     &0.5812727,0.5587846,0.5566773,0.5620723,0.5661795,
+     &0.5687336,0.5732306,0.5805613,0.5866805,0.5907671,
+     &0.5969589,0.5957459,0.5962836,0.6028957,0.6124275,
+     &0.6156567,0.6218417,0.6321118,0.6370467,0.6411974,
+     &0.6447079,0.6546141,0.6691408,0.6888857,0.7109522,
+     &0.7267580,0.7246028,0.7274987,0.7256792,0.7211279,
+     &0.7193315,0.7149989,0.7013977,0.6651995,0.5782154,
+     &0.5228451,0.4628350,0.4070674,0.3747672,0.3693838,
+     &0.3776684,0.3927504,0.4044872,0.4236842,0.4359979,
+     &0.4452721,0.4529338,0.4591291,0.4647588,0.4675789,
+     &0.4704044,0.4736306,0.4769657,0.4809483,0.4857694,
+     &0.4920136,0.5005317,0.5248833,0.5530189,0.5680709,
+     &0.5790995,0.6006733,0.6076213,0.6135495,0.6271621,
+     &0.6453611,0.7096416,0.7277915,0.7180390,0.7214272,
+     &0.7430624,0.7781302,0.8105813,0.8638036,0.8667906,
+     &0.8650255,0.8590664,0.8432143,0.8341830,0.8032821,
+     &0.6736456,0.5327421,0.3821245,0.3023261,0.2506925,
+     &0.2248830,0.2181999,0.2206931,0.2274191,0.2371715,
+     &0.2492834,0.2612511,0.2759819,0.2907880,0.3061035,
+     &0.3189336,0.3259392,0.3269015,0.3248960,0.3278614,
+     &0.3352942,0.3411323,0.3492400,0.3630564,0.3716860,
+     &0.3780700,0.3789840,0.3714330,0.3232819,0.2950966,
+     &0.2783259,0.2697008,0.2717506,0.2816038,0.2868812,
+     &0.2919132,0.2975354,0.3052135,0.3144514,0.3230745,
+     &0.3308428,0.3415695,0.3497911,0.3546669,0.3859474,
+     &0.3858507,0.3821296,0.3797063,0.3712473,0.3611613,
+     &0.3470088,0.2835475,0.2232076,0.2036654/
+       data gicevis/
+     &0.9488313,0.8737755,0.8699134,0.8632549,0.8664746,
+     &0.8654723,0.8639066,0.9867598,0.9718844,0.9635127,
+     &0.9558461,0.9512742,0.9462659,0.9400148,0.9322755,
+     &0.9239700,0.9149156,0.9062143,0.9031032,0.9042205,
+     &0.9072103,0.9088409,0.9101745,0.9125225,0.9162391,
+     &0.9205437,0.9242871,0.9270018,0.9297845,0.9314710,
+     &0.9314710,0.9295564,0.9256747,0.9176448,0.9091137,
+     &0.8993065,0.8857244,0.8742417,0.8625565,0.8491372,
+     &0.8415641,0.8312504,0.8189208,0.8167353,0.8238611,
+     &0.8239230,0.8371644,0.8417686,0.8616024,0.8695507,
+     &0.8752736,0.8796579,0.8782625,0.8792304,0.8746206,
+     &0.8405395,0.8161123,0.8190467/
+       data giceir/
+     &0.8215228,0.8188539,0.8235543,0.8430634,0.8634555,
+     &0.8889333,0.8943647,0.9004826,0.9057037,0.9118157,
+     &0.9151983,0.9186423,0.9165455,0.9109817,0.9085578,
+     &0.9069400,0.9043546,0.9010347,0.8988791,0.8976911,
+     &0.8963661,0.8980653,0.8983047,0.8966079,0.8940747,
+     &0.8933308,0.8913805,0.8891829,0.8896720,0.8898105,
+     &0.8894080,0.8870043,0.8841559,0.8807722,0.8783676,
+     &0.8806533,0.8874398,0.8930346,0.8980618,0.9013399,
+     &0.9038298,0.9075544,0.9122803,0.9171227,0.9216645,
+     &0.9230088,0.9236676,0.9233609,0.9217389,0.9185820,
+     &0.9143328,0.9086544,0.9041949,0.8948452,0.8875402,
+     &0.8805291,0.8743904,0.8689287,0.8643938,0.8621209,
+     &0.8597336,0.8575692,0.8550812,0.8520836,0.8486272,
+     &0.8446994,0.8398250,0.8288277,0.8186790,0.8140771,
+     &0.8110483,0.8041257,0.8015433,0.7980613,0.7919027,
+     &0.7852415,0.7688640,0.7656652,0.7660689,0.7611709,
+     &0.7521669,0.7417981,0.7344227,0.7222472,0.7201254,
+     &0.7173442,0.7131014,0.7038283,0.6999976,0.6905708,
+     &0.6637480,0.6310949,0.5964675,0.5787684,0.5612767,
+     &0.5405343,0.5222011,0.5027949,0.4812989,0.4589987,
+     &0.4483198,0.4369166,0.4259420,0.4192472,0.4154068,
+     &0.4142449,0.4130682,0.4088767,0.3968293,0.3857591,
+     &0.3742922,0.3692816,0.3648685,0.3617240,0.3566430,
+     &0.3508260,0.3437443,0.3361050,0.3206013,0.3090643,
+     &0.3008432,0.2916748,0.2902482,0.2839455,0.2766951,
+     &0.2723766,0.2683532,0.2648085,0.2613389,0.2555560,
+     &0.2486358,0.2367881,0.2269753,0.2207384,0.2052476,
+     &0.1863302,0.1759822,0.1676274,0.1511226,0.1356524,
+     &0.1210628,0.0811427,0.0511400,0.0412876/
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeropacity.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeropacity.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeropacity.F	(revision 46)
@@ -0,0 +1,458 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &    tauref,tau,aerosol,reffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+      real r0,reff,coefsize
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+      call zerophys(ngrid*naerkind,tau)
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          tracername=noms(iq)
+          IF (tracername(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        call zerophys(nlayer*naerkind,msolsir)
+        call zerophys(nlayer*naerkind,mqextsqabs)
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c  -------------------------------------------------------------
+c     1) Prescribed dust  (if tracer=F or active=F)
+c  -------------------------------------------------------------
+      IF ((.not.tracer) .or. (.not.active)) THEN 
+
+c       Vertical column optical depth at 700.Pa 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        IF(iaervar.eq.1) THEN 
+           do ig=1, ngridmx
+            tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                         ! or read in starfi
+          end do
+        ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+          tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+
+        ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+           taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+           tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+           tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+           do ig=1,ngrid/2  ! Northern hemisphere
+             tauref(ig)= tauN +
+     &       (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+           end do
+           do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+             tauref(ig)= tauS +
+     &       (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+           end do
+
+        ELSE IF ((iaervar.eq.4).or.
+     &           ((iaervar.ge.24).and.(iaervar.le.26)))
+     &       THEN  ! << "TES assimilated dust scenarios >>
+           call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+        ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+          tauref(1) = 2.5
+          if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+          do ig=2,ngrid
+            tauref(ig) = tauref(1)
+          end do
+        ELSE
+          stop 'problem with iaervar in aeropacity.F'
+        ENDIF
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+          expfactor=0.
+          CALL zerophys(ngrid,taudusttmp)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+c             Scaling factor
+              taudusttmp(ig)=taudusttmp(ig)+aerosol(ig,l,iaer)
+            ENDDO
+          ENDDO
+
+c         Rescaling each layer to reproduce the choosen (or
+c           assimilated) dust extinction opacity at visible
+c           reference wavelength, which is originally scaled
+c           to an equivalent 700Pa pressure surface.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              aerosol(ig,l,iaer) = tauref(ig) *
+     &                     pplev(ig,1) / 700.E0 *
+     &                     aerosol(ig,l,iaer) / taudusttmp(ig)
+            ENDDO
+          ENDDO
+
+          CALL zerophys(ngrid,taudustvis)
+          CALL zerophys(ngrid,taudusttes)
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              taudustvis(ig) = taudustvis(ig) + aerosol(ig,l,iaer)
+              taudusttes(ig) = taudusttes(ig) + aerosol(ig,l,iaer)*
+     &          QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer)*
+     &          ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+            ENDDO
+          ENDDO
+
+c         Outputs
+          IF (ngrid.NE.1) THEN
+!            CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR',
+!     &        ' ',2,taudusttes)
+            if (callstats) then
+              CALL wstats(ngridmx,'taudustTES','dust abs IR',
+     &          ' ',2,taudusttes)
+            endif
+          ELSE
+            CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU')
+          ENDIF
+
+c     changement dans le calcul de la distribution verticale          
+c     dans le cas des scenarios de poussieres assimiles
+c        if (iaervar.eq.4) THEN  ! TES
+c        call zerophys(ngrid*naerkind,tau)
+c
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c                tau(ig,1)=tau(ig,1)+ aerosol(ig,l,1)
+c           end do
+c        end do
+c        do l=1,nlayer
+c           do ig=1,ngrid
+c               aerosol(ig,l,1)=aerosol(ig,l,1)*tauref(ig)/tau(ig,1)
+c     $     *(pplev(ig,1)/700)
+c           end do
+c        end do
+c        endif
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccc       
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c  ---------------------------------------------------------------------
+c     2) Transported radiatively active dust  (if tracer=T and active=T)
+c ----------------------------------------------------------------------
+      ELSE  IF ((tracer) .and. (active)) THEN 
+c     The dust opacity is computed from q
+
+c     a) "doubleq" technique (transport of mass and number mixing ratio)
+c        ~~~~~~~~~~~~~~~~~~~
+       if(doubleq) then 
+
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+
+c        Computing effective radius :
+         do  l=1,nlayer
+           do ig=1, ngrid
+              r0=
+     &        (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+              r0=min(max(r0,1.e-10),500.e-6)
+              reff= ref_r0 * r0
+cc           If  reff is small, the transported dust mean Qext
+c            is reduced from the reference dust Qext by a factor "coefsize"
+
+             coefsize=min(max(2.52e6*reff-0.043 ,0.)   ,1.)
+
+cc              It is added 1.e-8 to pq to avoid low
+
+                aerosol(ig,l,1)=aerosol(ig,l,1)+ 1.E-8 +
+     &         ( 0.75*Qext(1)*coefsize/(rho_dust*reff))
+     &          * (pq(ig,l,nqdust(1)))*
+c               only one dust bin to use with doubleq
+     &          (pplev(ig,l)-pplev(ig,l+1))/g
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+
+c     b) Size bin technique (each aerosol can contribute to opacity))
+c        ~~~~~~~~~~~~~~~~~~
+       else
+c        The dust opacity is computed from q
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         do iq=1,dustbin
+           do l=1,nlayer
+              do ig=1,ngrid
+cc               qextrhor(iq) is  (3/4)*Qext/(rho*reff)
+cc               It is added 1.e-8 to pq to avoid low
+                 aerosol(ig,l,1)=aerosol(ig,l,1)+
+     &           qextrhor(nqdust(iq))*(pq(ig,l,nqdust(iq))+1.e-8)*
+     &           (pplev(ig,l)-pplev(ig,l+1))/g
+              end do
+           end do
+         end do
+         call zerophys(ngrid,tauref)
+       end if  ! (doubleq)
+      END IF   ! (dust scenario)
+
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+
+      IF (water.AND.activice) THEN
+c       1. Initialization
+        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))
+        CALL zerophys(ngrid,taucloudvis)
+        CALL zerophys(ngrid,taucloudtes)
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) =
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        ( pq(ig,l,i_ice) + 1.E-8 ) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+          CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+      ENDIF
+
+c==================================================================
+        END SELECT aerkind
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+
+      do l=1,nlayer
+         do ig=1,ngrid
+               tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+         end do
+      end do
+
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeroptproperties.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeroptproperties.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/aeroptproperties.F	(revision 46)
@@ -0,0 +1,1121 @@
+      SUBROUTINE aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                            QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                            QIRsQREF3d,omegaIR3d,gIR3d,
+     &                            QREFvis3d,QREFir3d,
+     &                            omegaREFvis3d,omegaREFir3d)
+      IMPLICIT NONE
+c     =============================================================
+c     Aerosol Optical Properties
+c
+c     Description:
+c       Compute the scattering parameters in each grid
+c       box, depending on aerosol grain sizes. Log-normal size
+c       distribution and Gauss-Legendre integration are used.
+
+c     Parameters:
+c       Don't forget to set the value of varyingnueff below; If
+c       the effective variance of the distribution for the given
+c       aerosol is considered homogeneous in the atmosphere, please
+c       set varyingnueff(iaer) to .false. Resulting computational
+c       time will be much better.
+
+c     Authors: J.-B. Madeleine, F. Forget, F. Montmessin
+c     =============================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+
+c     Local variables 
+c     ---------------
+
+c     =============================================================
+      LOGICAL, PARAMETER :: varyingnueff(naerkind) = .false.
+c     =============================================================
+
+c     Min. and max radius of the interpolation grid (in METERS)
+      REAL, PARAMETER :: refftabmin = 5e-8 !2e-8
+      REAL, PARAMETER :: refftabmax = 35e-6
+c     Log of the min and max variance of the interpolation grid
+      REAL, PARAMETER :: nuefftabmin = -4.6
+      REAL, PARAMETER :: nuefftabmax = 0.
+c     Number of effective radius of the interpolation grid
+      INTEGER, PARAMETER :: refftabsize = 100
+c     Number of effective variances of the interpolation grid
+      INTEGER, PARAMETER :: nuefftabsize = 100
+c     Interpolation grid indices (reff,nueff)
+      INTEGER :: grid_i,grid_j
+c     Intermediate variable
+      REAL :: var_tmp,var3d_tmp(ngridmx,nlayermx)
+c     Bilinear interpolation factors
+      REAL :: kx,ky,k1,k2,k3,k4
+c     Size distribution parameters
+      REAL :: sizedistk1,sizedistk2
+c     Pi!
+      REAL,SAVE :: pi
+c     Variables used by the Gauss-Legendre integration:
+      INTEGER radius_id,gausind
+      REAL kint
+      REAL drad
+      REAL weightgaus(5),radgaus(5)
+      SAVE weightgaus,radgaus
+      DATA weightgaus/.2955242247,.2692667193,.2190863625,
+     &                .1494513491,.0666713443/
+      DATA radgaus/.1488743389,.4333953941,.6794095682,
+     &             .8650633666,.9739065285/
+
+c     Indices
+      INTEGER :: i,j,k,l,m,iaer,idomain
+      INTEGER :: ig,lg,chg
+
+c     Local saved variables
+c     ---------------------
+
+c     Radius axis of the interpolation grid
+      REAL,SAVE :: refftab(refftabsize)
+c     Variance axis of the interpolation grid
+      REAL,SAVE :: nuefftab(nuefftabsize)
+c     Volume ratio of the grid
+      REAL,SAVE :: logvratgrid,vratgrid
+c     Grid used to remember which calculation is done
+      LOGICAL,SAVE :: checkgrid(refftabsize,nuefftabsize,naerkind,2)
+     &                = .false.
+c     Optical properties of the grid (VISIBLE)
+      REAL,SAVE :: qsqrefVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: qextVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: qscatVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: omegVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+      REAL,SAVE :: gVISgrid(refftabsize,nuefftabsize,nsun,naerkind)
+c     Optical properties of the grid (INFRARED)
+      REAL,SAVE :: qsqrefIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: qextIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: qscatIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: omegIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+      REAL,SAVE :: gIRgrid(refftabsize,nuefftabsize,nir,naerkind)
+c     Optical properties of the grid (REFERENCE WAVELENGTHS)
+      REAL,SAVE :: qrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefIRgrid(refftabsize,nuefftabsize,naerkind)
+c     Firstcall
+      LOGICAL,SAVE :: firstcall = .true.
+c     Variables used by the Gauss-Legendre integration:
+      REAL,SAVE :: normd(refftabsize,nuefftabsize,naerkind,2)
+      REAL,SAVE :: dista(refftabsize,nuefftabsize,naerkind,2,5)
+      REAL,SAVE :: distb(refftabsize,nuefftabsize,naerkind,2,5)
+
+      REAL,SAVE :: radGAUSa(5,naerkind,2)
+      REAL,SAVE :: radGAUSb(5,naerkind,2)
+
+      REAL,SAVE :: qsqrefVISa(nsun,5,naerkind)
+      REAL,SAVE :: qrefVISa(5,naerkind)
+      REAL,SAVE :: qsqrefVISb(nsun,5,naerkind)
+      REAL,SAVE :: qrefVISb(5,naerkind)
+      REAL,SAVE :: omegVISa(nsun,5,naerkind)
+      REAL,SAVE :: omegrefVISa(5,naerkind)
+      REAL,SAVE :: omegVISb(nsun,5,naerkind)
+      REAL,SAVE :: omegrefVISb(5,naerkind)
+      REAL,SAVE :: gVISa(nsun,5,naerkind)
+      REAL,SAVE :: gVISb(nsun,5,naerkind)
+
+      REAL,SAVE :: qsqrefIRa(nir,5,naerkind)
+      REAL,SAVE :: qrefIRa(5,naerkind)
+      REAL,SAVE :: qsqrefIRb(nir,5,naerkind)
+      REAL,SAVE :: qrefIRb(5,naerkind)
+      REAL,SAVE :: omegIRa(nir,5,naerkind)
+      REAL,SAVE :: omegrefIRa(5,naerkind)
+      REAL,SAVE :: omegIRb(nir,5,naerkind)
+      REAL,SAVE :: omegrefIRb(5,naerkind)
+      REAL,SAVE :: gIRa(nir,5,naerkind)
+      REAL,SAVE :: gIRb(nir,5,naerkind)
+
+      REAL :: radiusm
+      REAL :: radiusr
+
+c     Inputs
+c     ------
+
+      INTEGER :: ngrid,nlayer
+c     Aerosol effective radius used for radiative transfer (meter)
+      REAL :: reffrad(ngridmx,nlayermx,naerkind)
+c     Aerosol effective variance used for radiative transfer (n.u.)
+      REAL :: nueffrad(ngridmx,nlayermx,naerkind)
+
+c     Outputs
+c     -------
+
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+        IF ( (nsize(iaer,1).EQ.1).AND.(nsize(iaer,2).EQ.1) ) THEN
+c==================================================================
+c       If there is one single particle size, optical
+c         properties of the considered aerosol are homogeneous
+          DO lg = 1, nlayer
+            DO ig = 1, ngrid
+              DO chg = 1, nsun
+                QVISsQREF3d(ig,lg,chg,iaer)=QVISsQREF(chg,iaer,1)
+                omegaVIS3d(ig,lg,chg,iaer)=omegaVIS(chg,iaer,1)
+                gVIS3d(ig,lg,chg,iaer)=gVIS(chg,iaer,1)
+              ENDDO
+              DO chg = 1, nir
+                QIRsQREF3d(ig,lg,chg,iaer)=QIRsQREF(chg,iaer,1)
+                omegaIR3d(ig,lg,chg,iaer)=omegaIR(chg,iaer,1)
+                gIR3d(ig,lg,chg,iaer)=gIR(chg,iaer,1)
+              ENDDO
+              QREFvis3d(ig,lg,iaer)=QREFvis(iaer,1)
+              QREFir3d(ig,lg,iaer)=QREFir(iaer,1)
+              omegaREFvis3d(ig,lg,iaer)=omegaREFvis(iaer,1)
+              omegaREFir3d(ig,lg,iaer)=omegaREFir(iaer,1)
+            ENDDO
+          ENDDO
+        ELSE ! Varying effective radius and variance
+      DO idomain = 1, 2 ! Loop on visible or infrared channel
+c==================================================================
+c     1. Creating the effective radius and variance grid
+c     --------------------------------------------------
+      IF (firstcall) THEN
+
+c       1.1 Pi!
+        pi = 2. * asin(1.e0)
+
+c       1.2 Effective radius
+        refftab(1)    = refftabmin
+        refftab(refftabsize) = refftabmax
+
+        logvratgrid = log(refftabmax/refftabmin) /
+     &                float(refftabsize-1)*3.
+        vratgrid = exp(logvratgrid)
+
+        do i = 2, refftabsize-1
+          refftab(i) = refftab(i-1)*vratgrid**(1./3.)
+        enddo
+
+c       1.3 Effective variance
+        do i = 0, nuefftabsize-1
+          nuefftab(i+1) = exp( nuefftabmin +
+     &             i*(nuefftabmax-nuefftabmin)/(nuefftabsize-1) )
+        enddo
+        firstcall = .false.
+      ENDIF
+
+c       1.4 Radius middle point and range for Gauss integration
+        radiusm=
+     &         0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) +
+     &              radiustab(iaer,idomain,1))
+        radiusr=
+     &         0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) -
+     &              radiustab(iaer,idomain,1))
+
+c       1.5 Interpolating data at the Gauss quadrature points:
+        DO gausind=1,5
+          drad=radiusr*radgaus(gausind)
+          radGAUSa(gausind,iaer,idomain)=radiusm-drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) -
+     &                         (radiusm-drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) - 
+     &         (radiusm-drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+          kint = ( (radiusm-drad) - 
+     &             radiustab(iaer,idomain,radius_id) ) /
+     &           ( radiustab(iaer,idomain,radius_id+1) - 
+     &             radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,nsun
+            qsqrefVISa(m,gausind,iaer)=
+     &              (1-kint)*QVISsQREF(m,iaer,radius_id) + 
+     &              kint*QVISsQREF(m,iaer,radius_id+1)
+            omegVISa(m,gausind,iaer)=
+     &              (1-kint)*omegaVIS(m,iaer,radius_id) + 
+     &              kint*omegaVIS(m,iaer,radius_id+1)
+            gVISa(m,gausind,iaer)=
+     &              (1-kint)*gVIS(m,iaer,radius_id) + 
+     &              kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISa(gausind,iaer)=
+     &              (1-kint)*QREFvis(iaer,radius_id) + 
+     &              kint*QREFvis(iaer,radius_id+1)
+            omegrefVISa(gausind,iaer)=
+     &              (1-kint)*omegaREFvis(iaer,radius_id) + 
+     &              kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,nir
+            qsqrefIRa(m,gausind,iaer)=
+     &              (1-kint)*QIRsQREF(m,iaer,radius_id) + 
+     &              kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRa(m,gausind,iaer)=
+     &              (1-kint)*omegaIR(m,iaer,radius_id) + 
+     &              kint*omegaIR(m,iaer,radius_id+1)
+            gIRa(m,gausind,iaer)=
+     &              (1-kint)*gIR(m,iaer,radius_id) + 
+     &              kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRa(gausind,iaer)=
+     &              (1-kint)*QREFir(iaer,radius_id) + 
+     &              kint*QREFir(iaer,radius_id+1)
+            omegrefIRa(gausind,iaer)=
+     &              (1-kint)*omegaREFir(iaer,radius_id) + 
+     &              kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+
+        DO gausind=1,5
+          drad=radiusr*radgaus(gausind)
+          radGAUSb(gausind,iaer,idomain)=radiusm+drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) - 
+     &                         (radiusm+drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) - 
+     &         (radiusm+drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+            kint = ( (radiusm+drad) -
+     &               radiustab(iaer,idomain,radius_id) ) /
+     &             ( radiustab(iaer,idomain,radius_id+1) - 
+     &               radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,nsun
+            qsqrefVISb(m,gausind,iaer)=
+     &              (1-kint)*QVISsQREF(m,iaer,radius_id) + 
+     &              kint*QVISsQREF(m,iaer,radius_id+1)
+            omegVISb(m,gausind,iaer)=
+     &              (1-kint)*omegaVIS(m,iaer,radius_id) + 
+     &              kint*omegaVIS(m,iaer,radius_id+1)
+            gVISb(m,gausind,iaer)=
+     &              (1-kint)*gVIS(m,iaer,radius_id) + 
+     &              kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISb(gausind,iaer)=
+     &              (1-kint)*QREFvis(iaer,radius_id) + 
+     &              kint*QREFvis(iaer,radius_id+1)
+            omegrefVISb(gausind,iaer)=
+     &              (1-kint)*omegaREFvis(iaer,radius_id) + 
+     &              kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,nir
+            qsqrefIRb(m,gausind,iaer)=
+     &              (1-kint)*QIRsQREF(m,iaer,radius_id) + 
+     &              kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRb(m,gausind,iaer)=
+     &              (1-kint)*omegaIR(m,iaer,radius_id) + 
+     &              kint*omegaIR(m,iaer,radius_id+1)
+            gIRb(m,gausind,iaer)=
+     &              (1-kint)*gIR(m,iaer,radius_id) + 
+     &              kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRb(gausind,iaer)=
+     &              (1-kint)*QREFir(iaer,radius_id) + 
+     &              kint*QREFir(iaer,radius_id+1)
+            omegrefIRb(gausind,iaer)=
+     &              (1-kint)*omegaREFir(iaer,radius_id) + 
+     &              kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+c==================================================================
+      IF ( .NOT.varyingnueff(iaer) ) THEN          ! CONSTANT NUEFF
+c==================================================================
+c     2. Compute the scattering parameters using linear
+c       interpolation over grain sizes and constant nueff
+c     ---------------------------------------------------
+
+      DO lg = 1,nlayer
+        DO ig = 1,ngrid
+c         2.1 Effective radius index and kx calculation
+          var_tmp=reffrad(ig,lg,iaer)/refftabmin
+          var_tmp=log(var_tmp)*3.
+          var_tmp=var_tmp/logvratgrid+1.
+          grid_i=floor(var_tmp)
+          IF (grid_i.GE.refftabsize) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger grain sizes.'
+            grid_i=refftabsize-1
+            kx = 1.
+          ELSEIF (grid_i.LT.1) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller grain sizes.'
+            grid_i=1
+            kx = 0.
+          ELSE
+            kx = ( reffrad(ig,lg,iaer)-refftab(grid_i) ) /
+     &           ( refftab(grid_i+1)-refftab(grid_i) )
+          ENDIF
+c         2.3 Integration
+          DO j=grid_i,grid_i+1
+c             2.3.1 Check if the calculation has been done
+              IF (.NOT.checkgrid(j,1,iaer,idomain)) THEN
+c               2.3.2 Log-normal dist., r_g and sigma_g are defined
+c                 in [hansen_1974], "Light scattering in planetary
+c                 atmospheres", Space Science Reviews 16 527-610.
+c                 Here, sizedistk1=r_g and sizedistk2=sigma_g^2
+                sizedistk2 = log(1.+nueffrad(1,1,iaer))
+                sizedistk1 = exp(2.5*sizedistk2)
+                sizedistk1 = refftab(j) / sizedistk1
+
+                normd(j,1,iaer,idomain) = 1e-30
+                DO gausind=1,5
+                  drad=radiusr*radgaus(gausind)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              LOG((radiusm-drad)/sizedistk1)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              EXP(-dista(j,1,iaer,idomain,gausind) * 
+     &              dista(j,1,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm-drad)
+                  dista(j,1,iaer,idomain,gausind) =
+     &              dista(j,1,iaer,idomain,gausind) / 
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              LOG((radiusm+drad)/sizedistk1)
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              EXP(-distb(j,1,iaer,idomain,gausind) * 
+     &              distb(j,1,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm+drad)
+                  distb(j,1,iaer,idomain,gausind) = 
+     &              distb(j,1,iaer,idomain,gausind) / 
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  normd(j,1,iaer,idomain)=normd(j,1,iaer,idomain) +
+     &              weightgaus(gausind) *
+     &              (
+     &              distb(j,1,iaer,idomain,gausind) * pi * 
+     &              radGAUSb(gausind,iaer,idomain) * 
+     &              radGAUSb(gausind,iaer,idomain) +
+     &              dista(j,1,iaer,idomain,gausind) * pi * 
+     &              radGAUSa(gausind,iaer,idomain) * 
+     &              radGAUSa(gausind,iaer,idomain)
+     &              )
+                ENDDO
+                IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------
+c                 2.3.3.vis Initialization
+                  qsqrefVISgrid(j,1,:,iaer)=0.
+                  qextVISgrid(j,1,:,iaer)=0.
+                  qscatVISgrid(j,1,:,iaer)=0.
+                  omegVISgrid(j,1,:,iaer)=0.
+                  gVISgrid(j,1,:,iaer)=0.
+                  qrefVISgrid(j,1,iaer)=0.
+                  qscatrefVISgrid(j,1,iaer)=0.
+                  omegrefVISgrid(j,1,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nsun
+c                     Convolution:
+                      qextVISgrid(j,1,m,iaer) = 
+     &                  qextVISgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefVISb(m,gausind,iaer) * 
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) * 
+     &                  radGAUSb(gausind,iaer,idomain) * 
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  qsqrefVISa(m,gausind,iaer) * 
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) * 
+     &                  radGAUSa(gausind,iaer,idomain) * 
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      qscatVISgrid(j,1,m,iaer) = 
+     &                  qscatVISgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      gVISgrid(j,1,m,iaer) =
+     &                  gVISgrid(j,1,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gVISb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gVISa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefVISgrid(j,1,iaer) = 
+     &                qrefVISgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                    qscatrefVISgrid(j,1,iaer) = 
+     &                qscatrefVISgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefVISb(gausind,iaer) *
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                omegrefVISa(gausind,iaer) *
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+
+                  qrefVISgrid(j,1,iaer)=qrefVISgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  qscatrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  omegrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /
+     &                         qrefVISgrid(j,1,iaer)
+                  DO m=1,nsun
+                    qextVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    qscatVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    gVISgrid(j,1,m,iaer)=gVISgrid(j,1,m,iaer) / 
+     &                          qscatVISgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+
+                    qsqrefVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /
+     &                          qrefVISgrid(j,1,iaer)
+                    omegVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) / 
+     &                          qextVISgrid(j,1,m,iaer)
+                  ENDDO
+                ELSE                   ! INFRARED DOMAIN ----------
+c                 2.3.3.ir Initialization
+                  qsqrefIRgrid(j,1,:,iaer)=0.
+                  qextIRgrid(j,1,:,iaer)=0.
+                  qscatIRgrid(j,1,:,iaer)=0.
+                  omegIRgrid(j,1,:,iaer)=0.
+                  gIRgrid(j,1,:,iaer)=0.
+                  qrefIRgrid(j,1,iaer)=0.
+                  qscatrefIRgrid(j,1,iaer)=0.
+                  omegrefIRgrid(j,1,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nir
+c                     Convolution:
+                      qextIRgrid(j,1,m,iaer) = 
+     &                  qextIRgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefIRb(m,gausind,iaer) * 
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) * 
+     &                  radGAUSb(gausind,iaer,idomain) * 
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  qsqrefIRa(m,gausind,iaer) * 
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) * 
+     &                  radGAUSa(gausind,iaer,idomain) * 
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      qscatIRgrid(j,1,m,iaer) = 
+     &                  qscatIRgrid(j,1,m,iaer) + 
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                      gIRgrid(j,1,m,iaer) =
+     &                  gIRgrid(j,1,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gIRb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,1,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gIRa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,1,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefIRgrid(j,1,iaer) = 
+     &                qrefIRgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                    qscatrefIRgrid(j,1,iaer) = 
+     &                qscatrefIRgrid(j,1,iaer) + 
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefIRb(gausind,iaer) *
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) * 
+     &                radGAUSb(gausind,iaer,idomain) * 
+     &                distb(j,1,iaer,idomain,gausind) +
+     &                omegrefIRa(gausind,iaer) *
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) * 
+     &                radGAUSa(gausind,iaer,idomain) * 
+     &                dista(j,1,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+
+                  qrefIRgrid(j,1,iaer)=qrefIRgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  qscatrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                  omegrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /
+     &                         qrefIRgrid(j,1,iaer)
+                  DO m=1,nir
+                    qextIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    qscatIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+                    gIRgrid(j,1,m,iaer)=gIRgrid(j,1,m,iaer) / 
+     &                          qscatIRgrid(j,1,m,iaer) /
+     &                          normd(j,1,iaer,idomain)
+
+                    qsqrefIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /
+     &                          qrefVISgrid(j,1,iaer)
+                    omegIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) / 
+     &                          qextIRgrid(j,1,m,iaer)
+                  ENDDO
+                ENDIF                  ! --------------------------
+                checkgrid(j,1,iaer,idomain) = .true.
+              ENDIF !checkgrid
+          ENDDO !grid_i
+c         2.4 Linear interpolation
+          k1 = (1-kx)
+          k2 = kx
+          IF (idomain.EQ.1) THEN ! VISIBLE ------------------------
+          DO m=1,nsun
+            QVISsQREF3d(ig,lg,m,iaer) =
+     &                  k1*qsqrefVISgrid(grid_i,1,m,iaer) +
+     &                  k2*qsqrefVISgrid(grid_i+1,1,m,iaer)
+            omegaVIS3d(ig,lg,m,iaer) =
+     &                  k1*omegVISgrid(grid_i,1,m,iaer) +
+     &                  k2*omegVISgrid(grid_i+1,1,m,iaer)
+            gVIS3d(ig,lg,m,iaer) =
+     &                  k1*gVISgrid(grid_i,1,m,iaer) +
+     &                  k2*gVISgrid(grid_i+1,1,m,iaer)
+          ENDDO !nsun
+          QREFvis3d(ig,lg,iaer) =
+     &                  k1*qrefVISgrid(grid_i,1,iaer) +
+     &                  k2*qrefVISgrid(grid_i+1,1,iaer)
+          omegaREFvis3d(ig,lg,iaer) =
+     &                  k1*omegrefVISgrid(grid_i,1,iaer) +
+     &                  k2*omegrefVISgrid(grid_i+1,1,iaer)
+          ELSE                   ! INFRARED -----------------------
+          DO m=1,nir
+            QIRsQREF3d(ig,lg,m,iaer) =
+     &                  k1*qsqrefIRgrid(grid_i,1,m,iaer) +
+     &                  k2*qsqrefIRgrid(grid_i+1,1,m,iaer)
+            omegaIR3d(ig,lg,m,iaer) =
+     &                  k1*omegIRgrid(grid_i,1,m,iaer) +
+     &                  k2*omegIRgrid(grid_i+1,1,m,iaer)
+            gIR3d(ig,lg,m,iaer) =
+     &                  k1*gIRgrid(grid_i,1,m,iaer) +
+     &                  k2*gIRgrid(grid_i+1,1,m,iaer)
+          ENDDO !nir
+          QREFir3d(ig,lg,iaer) =
+     &                  k1*qrefIRgrid(grid_i,1,iaer) +
+     &                  k2*qrefIRgrid(grid_i+1,1,iaer)
+          omegaREFir3d(ig,lg,iaer) =
+     &                  k1*omegrefIRgrid(grid_i,1,iaer) +
+     &                  k2*omegrefIRgrid(grid_i+1,1,iaer)
+          ENDIF                  ! --------------------------------
+        ENDDO !nlayermx
+      ENDDO !ngridmx
+c==================================================================
+      ELSE                                          ! VARYING NUEFF
+c==================================================================
+c     3. Compute the scattering parameters in each grid box
+c       using bilinear interpolation over the grain sizes
+c       and the effective variances;
+c     -----------------------------------------------------
+
+      DO lg = 1,nlayer
+        DO ig = 1,ngrid
+c         3.1 Effective variance index and ky calculation
+          var_tmp=log(nueffrad(ig,lg,iaer))
+          grid_j=floor( (nuefftabsize-1)/(nuefftabmax-nuefftabmin)*
+     &       (var_tmp-nuefftabmin)+1. )
+          IF (grid_j.GE.nuefftabsize) THEN
+c           WRITE(*,*) 'Warning: effective variance '
+c           WRITE(*,*) 'is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger values.'
+            grid_j=nuefftabsize-1
+            ky = 1.
+          ELSEIF (grid_j.LT.1) THEN
+c           WRITE(*,*) 'Warning: effective variance '
+c           WRITE(*,*) 'is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller values.'
+            grid_j=1
+            ky = 0.
+          ELSE
+            ky = ( nueffrad(ig,lg,iaer)-nuefftab(grid_j) ) /
+     &           ( nuefftab(grid_j+1)-nuefftab(grid_j) )
+          ENDIF
+c         3.2 Effective radius index and kx calculation
+          var_tmp=reffrad(ig,lg,iaer)/refftabmin
+          var_tmp=log(var_tmp)*3.
+          var_tmp=var_tmp/logvratgrid+1.
+          grid_i=floor(var_tmp)
+          IF (grid_i.GE.refftabsize) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too large to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to larger grain sizes.'
+            grid_i=refftabsize-1
+            kx = 1.
+          ELSEIF (grid_i.LT.1) THEN
+c           WRITE(*,*) 'Warning: particle size in grid box #'
+c           WRITE(*,*) ig,' is too small to be used by the '
+c           WRITE(*,*) 'radiative transfer; please extend the '
+c           WRITE(*,*) 'interpolation grid to smaller grain sizes.'
+            grid_i=1
+            kx = 0.
+          ELSE
+            kx = ( reffrad(ig,lg,iaer)-refftab(grid_i) ) /
+     &           ( refftab(grid_i+1)-refftab(grid_i) )
+          ENDIF
+c         3.3 Integration
+          DO j=grid_i,grid_i+1
+            DO k=grid_j,grid_j+1
+c             3.3.1 Check if the calculation has been done
+              IF (.NOT.checkgrid(j,k,iaer,idomain)) THEN
+
+c               3.3.2 Log-normal dist., r_g and sigma_g are defined
+c                 in [hansen_1974], "Light scattering in planetary
+c                 atmospheres", Space Science Reviews 16 527-610.
+c                 Here, sizedistk1=r_g and sizedistk2=sigma_g^2
+                sizedistk2 = log(1.+nuefftab(k))
+                sizedistk1 = exp(2.5*sizedistk2)
+                sizedistk1 = refftab(j) / sizedistk1
+
+                normd(j,k,iaer,idomain) = 1e-30
+                DO gausind=1,5
+                  drad=radiusr*radgaus(gausind)
+
+                  dista(j,k,iaer,idomain,gausind) =
+     &              LOG((radiusm-drad)/sizedistk1)
+                  dista(j,k,iaer,idomain,gausind) =
+     &              EXP(-dista(j,k,iaer,idomain,gausind) *
+     &              dista(j,k,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm-drad)
+                  dista(j,k,iaer,idomain,gausind) =
+     &              dista(j,k,iaer,idomain,gausind) /
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  distb(j,k,iaer,idomain,gausind) =
+     &              LOG((radiusm+drad)/sizedistk1)
+                  distb(j,k,iaer,idomain,gausind) =
+     &              EXP(-distb(j,k,iaer,idomain,gausind) *
+     &              distb(j,k,iaer,idomain,gausind) *
+     &              0.5e0/sizedistk2)/(radiusm+drad)
+                  distb(j,k,iaer,idomain,gausind) =
+     &              distb(j,k,iaer,idomain,gausind) /
+     &              (sqrt(2e0*pi*sizedistk2))
+
+                  normd(j,k,iaer,idomain)=normd(j,k,iaer,idomain) +
+     &              weightgaus(gausind) *
+     &              (
+     &              distb(j,k,iaer,idomain,gausind) * pi *
+     &              radGAUSb(gausind,iaer,idomain) *
+     &              radGAUSb(gausind,iaer,idomain) +
+     &              dista(j,k,iaer,idomain,gausind) * pi *
+     &              radGAUSa(gausind,iaer,idomain) *
+     &              radGAUSa(gausind,iaer,idomain)
+     &              )
+                ENDDO
+                IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------
+c                 2.3.3.vis Initialization
+                  qsqrefVISgrid(j,k,:,iaer)=0.
+                  qextVISgrid(j,k,:,iaer)=0.
+                  qscatVISgrid(j,k,:,iaer)=0.
+                  omegVISgrid(j,k,:,iaer)=0.
+                  gVISgrid(j,k,:,iaer)=0.
+                  qrefVISgrid(j,k,iaer)=0.
+                  qscatrefVISgrid(j,k,iaer)=0.
+                  omegrefVISgrid(j,k,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nsun
+c                     Convolution:
+                      qextVISgrid(j,k,m,iaer) =
+     &                  qextVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      qscatVISgrid(j,k,m,iaer) =
+     &                  qscatVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      gVISgrid(j,k,m,iaer) =
+     &                  gVISgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegVISb(m,gausind,iaer) *
+     &                  qsqrefVISb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gVISb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegVISa(m,gausind,iaer) *
+     &                  qsqrefVISa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gVISa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefVISgrid(j,k,iaer) =
+     &                qrefVISgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                    qscatrefVISgrid(j,k,iaer) =
+     &                qscatrefVISgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefVISb(gausind,iaer) *
+     &                qrefVISb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                omegrefVISa(gausind,iaer) *
+     &                qrefVISa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+                  qrefVISgrid(j,k,iaer)=qrefVISgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  qscatrefVISgrid(j,k,iaer)=qscatrefVISgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  omegrefVISgrid(j,k,iaer)=qscatrefVISgrid(j,k,iaer) /
+     &                         qrefVISgrid(j,k,iaer)
+                  DO m=1,nsun
+                    qextVISgrid(j,k,m,iaer)=qextVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    qscatVISgrid(j,k,m,iaer)=qscatVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    gVISgrid(j,k,m,iaer)=gVISgrid(j,k,m,iaer) /
+     &                          qscatVISgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+
+                    qsqrefVISgrid(j,k,m,iaer)=qextVISgrid(j,k,m,iaer) /
+     &                          qrefVISgrid(j,k,iaer)
+                    omegVISgrid(j,k,m,iaer)=qscatVISgrid(j,k,m,iaer) /
+     &                          qextVISgrid(j,k,m,iaer)
+                  ENDDO
+                ELSE                   ! INFRARED DOMAIN ----------
+c                 2.3.3.ir Initialization
+                  qsqrefIRgrid(j,k,:,iaer)=0.
+                  qextIRgrid(j,k,:,iaer)=0.
+                  qscatIRgrid(j,k,:,iaer)=0.
+                  omegIRgrid(j,k,:,iaer)=0.
+                  gIRgrid(j,k,:,iaer)=0.
+                  qrefIRgrid(j,k,iaer)=0.
+                  qscatrefIRgrid(j,k,iaer)=0.
+                  omegrefIRgrid(j,k,iaer)=0.
+
+                  DO gausind=1,5
+                    DO m=1,nir
+c                     Convolution:
+                      qextIRgrid(j,k,m,iaer) =
+     &                  qextIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      qscatIRgrid(j,k,m,iaer) =
+     &                  qscatIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                      gIRgrid(j,k,m,iaer) =
+     &                  gIRgrid(j,k,m,iaer) +
+     &                  weightgaus(gausind) *
+     &                  (
+     &                  omegIRb(m,gausind,iaer) *
+     &                  qsqrefIRb(m,gausind,iaer) *
+     &                  qrefVISb(gausind,iaer) *
+     &                  gIRb(m,gausind,iaer) *
+     &                  pi*radGAUSb(gausind,iaer,idomain) *
+     &                  radGAUSb(gausind,iaer,idomain) *
+     &                  distb(j,k,iaer,idomain,gausind) +
+     &                  omegIRa(m,gausind,iaer) *
+     &                  qsqrefIRa(m,gausind,iaer) *
+     &                  qrefVISa(gausind,iaer) *
+     &                  gIRa(m,gausind,iaer) *
+     &                  pi*radGAUSa(gausind,iaer,idomain) *
+     &                  radGAUSa(gausind,iaer,idomain) *
+     &                  dista(j,k,iaer,idomain,gausind)
+     &                  )
+                    ENDDO
+                    qrefIRgrid(j,k,iaer) =
+     &                qrefIRgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                    qscatrefIRgrid(j,k,iaer) =
+     &                qscatrefIRgrid(j,k,iaer) +
+     &                weightgaus(gausind) *
+     &                (
+     &                omegrefIRb(gausind,iaer) *
+     &                qrefIRb(gausind,iaer) *
+     &                pi*radGAUSb(gausind,iaer,idomain) *
+     &                radGAUSb(gausind,iaer,idomain) *
+     &                distb(j,k,iaer,idomain,gausind) +
+     &                omegrefIRa(gausind,iaer) *
+     &                qrefIRa(gausind,iaer) *
+     &                pi*radGAUSa(gausind,iaer,idomain) *
+     &                radGAUSa(gausind,iaer,idomain) *
+     &                dista(j,k,iaer,idomain,gausind)
+     &                )
+                  ENDDO
+                  qrefIRgrid(j,k,iaer)=qrefIRgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  qscatrefIRgrid(j,k,iaer)=qscatrefIRgrid(j,k,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                  omegrefIRgrid(j,k,iaer)=qscatrefIRgrid(j,k,iaer) /
+     &                         qrefIRgrid(j,k,iaer)
+                  DO m=1,nir
+                    qextIRgrid(j,k,m,iaer)=qextIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    qscatIRgrid(j,k,m,iaer)=qscatIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+                    gIRgrid(j,k,m,iaer)=gIRgrid(j,k,m,iaer) /
+     &                          qscatIRgrid(j,k,m,iaer) /
+     &                          normd(j,k,iaer,idomain)
+
+                    qsqrefIRgrid(j,k,m,iaer)=qextIRgrid(j,k,m,iaer) /
+     &                          qrefVISgrid(j,k,iaer)
+                    omegIRgrid(j,k,m,iaer)=qscatIRgrid(j,k,m,iaer) /
+     &                          qextIRgrid(j,k,m,iaer)
+                  ENDDO
+                ENDIF                  ! --------------------------
+                checkgrid(j,k,iaer,idomain) = .true.
+              ENDIF !checkgrid
+            ENDDO !grid_j
+          ENDDO !grid_i
+c         3.4 Bilinear interpolation
+          k1 = (1-kx)*(1-ky)
+          k2 = kx*(1-ky)
+          k3 = kx*ky
+          k4 = (1-kx)*ky
+          IF (idomain.EQ.1) THEN ! VISIBLE ------------------------
+          DO m=1,nsun
+            QVISsQREF3d(ig,lg,m,iaer) = 
+     &                  k1*qsqrefVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*qsqrefVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*qsqrefVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*qsqrefVISgrid(grid_i,grid_j+1,m,iaer)
+            omegaVIS3d(ig,lg,m,iaer) = 
+     &                  k1*omegVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*omegVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*omegVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*omegVISgrid(grid_i,grid_j+1,m,iaer)
+            gVIS3d(ig,lg,m,iaer) = 
+     &                  k1*gVISgrid(grid_i,grid_j,m,iaer) +
+     &                  k2*gVISgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*gVISgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*gVISgrid(grid_i,grid_j+1,m,iaer)
+          ENDDO !nsun
+          QREFvis3d(ig,lg,iaer) = 
+     &                  k1*qrefVISgrid(grid_i,grid_j,iaer) +
+     &                  k2*qrefVISgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*qrefVISgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*qrefVISgrid(grid_i,grid_j+1,iaer)
+          omegaREFvis3d(ig,lg,iaer) = 
+     &                  k1*omegrefVISgrid(grid_i,grid_j,iaer) +
+     &                  k2*omegrefVISgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*omegrefVISgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*omegrefVISgrid(grid_i,grid_j+1,iaer)
+          ELSE                   ! INFRARED -----------------------
+          DO m=1,nir
+            QIRsQREF3d(ig,lg,m,iaer) = 
+     &                  k1*qsqrefIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*qsqrefIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*qsqrefIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*qsqrefIRgrid(grid_i,grid_j+1,m,iaer)
+            omegaIR3d(ig,lg,m,iaer) = 
+     &                  k1*omegIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*omegIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*omegIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*omegIRgrid(grid_i,grid_j+1,m,iaer)
+            gIR3d(ig,lg,m,iaer) =
+     &                  k1*gIRgrid(grid_i,grid_j,m,iaer) + 
+     &                  k2*gIRgrid(grid_i+1,grid_j,m,iaer) +
+     &                  k3*gIRgrid(grid_i+1,grid_j+1,m,iaer) +
+     &                  k4*gIRgrid(grid_i,grid_j+1,m,iaer)
+          ENDDO !nir
+          QREFir3d(ig,lg,iaer) =
+     &                  k1*qrefIRgrid(grid_i,grid_j,iaer) +
+     &                  k2*qrefIRgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*qrefIRgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*qrefIRgrid(grid_i,grid_j+1,iaer)
+          omegaREFir3d(ig,lg,iaer) =
+     &                  k1*omegrefIRgrid(grid_i,grid_j,iaer) +
+     &                  k2*omegrefIRgrid(grid_i+1,grid_j,iaer) +
+     &                  k3*omegrefIRgrid(grid_i+1,grid_j+1,iaer) +
+     &                  k4*omegrefIRgrid(grid_i,grid_j+1,iaer)
+          ENDIF                  ! --------------------------------
+        ENDDO !nlayermx
+      ENDDO !ngridmx
+
+      ENDIF ! varyingnueff
+c==================================================================
+      ENDDO ! idomain
+
+      ENDIF ! nsize = 1
+
+      ENDDO ! iaer (loop on aerosol kind)
+
+      RETURN
+      END
+
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/albedocaps.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/albedocaps.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/albedocaps.F90	(revision 46)
@@ -0,0 +1,375 @@
+subroutine albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
+
+! routine which changes the albedo (and emissivity) of the surface
+! depending on the presence of CO2 ice on the surface
+
+! to use the 'getin' routine 
+use ioipsl_getincom 
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"surfdat.h"
+
+! arguments:
+real,intent(in) :: zls ! solar longitude (rad)
+integer,intent(in) :: ngrid
+real,intent(in) :: piceco2(ngrid) ! amount of CO2 ice on the surface (kg/m2)
+real,intent(out) :: psolaralb(ngrid,2) ! albedo of the surface
+real,intent(out) :: emisref(ngrid) ! emissivity of the surface
+
+
+! local variables:
+logical,save :: firstcall=.true.
+integer :: ig,icap
+
+! 1. Initializations
+if (firstcall) then
+  ! find out if user wants to use TES cap albedoes or not
+  TESicealbedo=.false. ! default value 
+  write(*,*)" albedocaps: Use TES Cap albedoes ?"
+  call getin("TESicealbedo",TESicealbedo)
+  write(*,*)" albedocaps: TESicealbedo = ",TESicealbedo
+  
+  ! if using TES albedoes, load coeffcients
+  if (TESicealbedo) then
+    write(*,*)" albedocaps: Coefficient for Northern Cap ?"
+    TESice_Ncoef=1.0 ! default value
+    call getin("TESice_Ncoef",TESice_Ncoef)
+    write(*,*)" albedocaps: TESice_Ncoef = ",TESice_Ncoef
+    
+    write(*,*)" albedocaps: Coefficient for Southern Cap ?"
+    TESice_Scoef=1.0 ! default value
+    call getin("TESice_Scoef",TESice_Scoef)
+    write(*,*)" albedocaps: TESice_Scoef = ",TESice_Scoef
+  endif
+  
+  firstcall=.false.
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+  if (ig.gt.ngrid/2+1) then
+    icap=2 ! Southern hemisphere
+  else
+    icap=1 ! Northern hemisphere
+  endif
+
+  if (piceco2(ig).gt.0) then
+    ! set emissivity of surface to be the ice emissivity
+    emisref(ig)=emisice(icap)
+    ! set the surface albedo to be the ice albedo
+    if (TESicealbedo) then
+!      write(*,*) "albedocaps: call TES_icecap_albedo"
+!      write(*,*) "albedocaps: zls=",zls," ig=",ig
+      call TES_icecap_albedo(zls,ig,psolaralb(ig,1))
+!      write(*,*) "albedocaps: psolaralb(ig,1)=",psolaralb(ig,1)
+      psolaralb(ig,2)=psolaralb(ig,1)
+    else
+      psolaralb(ig,1)=albedice(icap)
+      psolaralb(ig,2)=albedice(icap)
+    endif
+  else
+    ! set emissivity of surface to be bare ground emissivity
+    emisref(ig)=emissiv
+    ! set the surface albedo to bare ground albedo 
+    psolaralb(ig,1)=albedodat(ig)
+    psolaralb(ig,2)=albedodat(ig)
+  endif ! of if (piceco2(ig).gt.0)
+enddo ! of ig=1,ngrid
+
+end subroutine albedocaps
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine TES_icecap_albedo(zls,ig,alb)
+
+implicit none
+#include"dimensions.h"
+#include"dimphys.h"
+#include"surfdat.h"
+#include"comgeomfi.h"
+#include"netcdf.inc"
+#include"datafile.h"
+
+! arguments:
+real,intent(in) :: zls ! solar longitude (rad)
+integer,intent(in) :: ig ! grid point index
+real,intent(out) :: alb ! (interpolated) TES ice albedo at that grid point
+
+! local variables:
+logical,save :: firstcall=.true.
+real,save :: zls_old ! value of zls from a previous call
+integer,save :: tinf,tsup ! encompassing time indexes of TES data
+real,save :: reltime ! relative position in-between time indexes (in [0;1])
+integer :: latinf,latsup ! encompassing latitude indexes of TES data
+real :: rellat ! relative position in-between latitude indexes (in[0;1])
+integer :: loninf,lonsup ! encompassing longitude indexes of TES data
+real :: rellon !relative position in-between longitude indexes (in[0;1])
+real,save :: pi,radeg ! to convert radians to degrees
+real :: zlsd ! solar longitude, in degrees
+real :: latd ! latitude, in degrees
+real :: lond ! longitude, in degrees
+integer :: i
+integer :: icap ! =1: Northern hemisphere =2: Southern hemisphere
+
+! TES datasets: (hard coded fixed length/sizes; for now)
+integer,parameter :: TESlonsize=72
+real,parameter :: TESdeltalon=5.0 ! step in longitude in TES files
+! longitudes, in TES files, in degrees, from TESlon(1)=-177.5 to TESlon(72)=177.5
+real,save :: TESlon(TESlonsize) 
+integer,parameter :: TESlatsize=30
+real,parameter :: TESdeltalat=2.0 ! step in latitude in TES files
+! latitudes (north hemisphere file), in degrees, from TESlatn(1)=31,
+! to TESlatn(30)=89 ; TESlatn(8)=45
+real,parameter :: TESlatnmin=45. ! minimum TES latitude (North hemisphere)
+real,parameter :: TESlatsmax=-45. ! maximum TES latitude (South hemisphere)
+real,save :: TESlatn(TESlatsize)
+! latitudes (south hemisphere file), in degrees, from TESlats(1)=-89,
+! to TESlats(30)=-31 ; TESlats(23)=-45
+real,save :: TESlats(TESlatsize)
+integer,parameter :: TESlssize=72
+real,parameter :: TESdeltals=5.0 ! step in solar longitude in TES files
+! Solar longitude in TES files, TESls(1)=2.5 to TESls(72)=357.5
+real,save :: TESls(TESlssize)
+! TES North albedo (=-1 for missing values)
+real,save :: TESalbn(TESlonsize,TESlatsize,TESlssize)
+! TES South albedo (=-1 for missing values)
+real,save :: TESalbs(TESlonsize,TESlatsize,TESlssize)
+! encompassing nodes arranged as follow : 4 3
+real :: val(4)                          ! 1 2 
+
+!NetCDF variables:
+integer :: ierr ! NetCDF status
+integer :: nid ! NetCDF file ID
+integer :: nvarid ! NetCDF variable ID
+
+! 0. Preliminary stuff
+if (firstcall) then
+! Load TES albedoes for Northern Hemisphere
+  ! Note: datafile() is defined in "datafile.h"
+  ierr=NF_OPEN(trim(datafile)//"/npsc_albedo.nc",NF_NOWRITE,nid)
+  IF (ierr.NE.NF_NOERR) THEN
+    write(*,*)'Problem opening npsc_albedo.nc (phymars/albedocaps.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, npsc_albedo.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_VARID(nid,"longitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find longitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlon)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"latitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find latitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlatn)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"time",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find time in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESls)
+  endif
+  
+  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find albedo in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbn)
+  endif
+
+! Load albedoes for Southern Hemisphere
+  ierr=NF_OPEN(trim(datafile)//"/spsc_albedo.nc",NF_NOWRITE,nid)
+  IF (ierr.NE.NF_NOERR) THEN
+    write(*,*)'Problem opening spsc_albedo.nc (phymars/albedocaps.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, spsc_albedo.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_VARID(nid,"latitude",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find latitude in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlats)
+  endif
+
+  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "Failed to find albedo in file!"
+  else
+    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbs)
+  endif
+
+! constants:
+  pi=acos(-1.)
+  radeg=180/pi
+
+  zls_old=-999 ! dummy initialization
+
+  firstcall=.false.
+endif ! of if firstcall
+
+! 1. Identify hemisphere and encompassing latitudes
+if (ig.GT.ngridmx/2+1) then
+  icap=2 ! Southern hemisphere
+else
+  icap=1 ! Northern hemisphere
+endif
+
+! Check that latitude is such that there is TES data to use
+! (ie: latitude 45 deg and poleward) otherwise use 'default' albedoes
+latd=lati(ig)*radeg ! latitude, in degrees
+if (icap.eq.1) then
+ ! North hemisphere
+ if (latd.lt.TESlatnmin) then
+   alb=albedice(1)
+   ! the job is done; quit this routine
+   return
+ else
+   ! find encompassing latitudes
+   if (latd.ge.TESlatn(TESlatsize)) then
+     latinf=TESlatsize
+     latsup=TESlatsize
+     rellat=0.
+   else
+     do i=1,TESlatsize-1
+       if ((latd.ge.TESlatn(i)).and.(latd.lt.TESlatn(i+1))) then
+         latinf=i
+         latsup=i+1
+         rellat=(latd-TESlatn(i))/TESdeltalat
+         exit ! found encompassing indexes; quit loop
+       endif
+     enddo
+   endif
+ endif ! of if (latd.lt.TESlatnmin)
+else ! icap=2
+ ! South hemisphere
+ if (latd.gt.TESlatsmax) then
+   alb=albedice(2)
+   ! the job is done; quit this routine
+   return
+ else
+   ! find encompassing latitudes
+   if (latd.lt.TESlats(1)) then
+     latinf=1
+     latsup=1
+     rellat=0.
+   else
+     do i=1,TESlatsize-1
+       if ((latd.ge.TESlats(i)).and.(latd.lt.TESlats(i+1))) then
+         latinf=i
+         latsup=i+1
+         rellat=(latd-TESlats(i))/TESdeltalat
+         exit ! found encompassing indexes; quit loop
+       endif
+     enddo
+   endif
+ endif ! of if (latd.gt.-45.)
+endif ! of if (icap.eq.1)
+
+! 2. Identify encompassing time indexes
+if (zls.ne.zls_old) then
+  zlsd=zls*radeg ! solar longitude, in degrees
+  
+  if (zlsd.lt.TESls(1)) then
+    tinf=TESlssize
+    tsup=1
+    reltime=0.5+zlsd/TESdeltals
+  else
+    if (zlsd.ge.TESls(TESlssize)) then
+      tinf=TESlssize
+      tsup=1
+      reltime=(360.-zlsd)/TESdeltals
+    else
+      ! look for encompassing indexes
+      do i=1,TESlssize-1
+        if ((zlsd.ge.TESls(i)).and.(zlsd.lt.TESls(i+1))) then
+          tinf=i
+          tsup=i+1
+          reltime=(zlsd-TESls(i))/TESdeltals
+          exit ! quit loop, we found the indexes
+        endif
+      enddo
+    endif
+  endif ! of if (zlsd.lt.TESls(1))
+  
+  zls_old=zls ! store current zls
+endif ! of if (zls.ne.zls_old)
+
+! 3. Identify encompassing longitudes
+lond=long(ig)*radeg ! east longitude, in degrees
+if (lond.lt.TESlon(1)) then
+  loninf=TESlonsize
+  lonsup=1
+  rellon=0.5+(180.+lond)/TESdeltalon
+else
+  if (lond.ge.TESlon(TESlonsize)) then
+    loninf=TESlonsize
+    lonsup=1
+    rellon=(180-lond)/TESdeltalon
+  else
+    do i=1,TESlonsize-1
+      if ((lond.ge.TESlon(i)).and.(lond.lt.TESlon(i+1))) then
+        loninf=i
+        lonsup=i+1
+        rellon=(lond-TESlon(i))/TESdeltalon
+        exit ! quit loop, we found the indexes
+      endif
+    enddo
+  endif ! of if (lond.ge.TESlon(TESlonsize))
+endif ! of if (lond.lt.TESlon(1))
+
+! 4. Use linear interpolation in time to build encompassing nodal values
+!    encompassing nodes are arranged as follow : 4 3
+!                                                1 2
+if (icap.eq.1) then
+  ! Northern hemisphere
+  val(1)=(1.-reltime)*TESalbn(loninf,latinf,tinf) &
+         +reltime*TESalbn(loninf,latinf,tsup)
+  val(2)=(1.-reltime)*TESalbn(lonsup,latinf,tinf) &
+         +reltime*TESalbn(lonsup,latinf,tsup)
+  val(3)=(1.-reltime)*TESalbn(lonsup,latsup,tinf) &
+         +reltime*TESalbn(lonsup,latsup,tsup)
+  val(4)=(1.-reltime)*TESalbn(loninf,latsup,tinf) &
+         +reltime*TESalbn(loninf,latsup,tsup)
+else
+  ! Southern hemisphere
+  val(1)=(1.-reltime)*TESalbs(loninf,latinf,tinf) &
+         +reltime*TESalbs(loninf,latinf,tsup)
+  val(2)=(1.-reltime)*TESalbs(lonsup,latinf,tinf) &
+         +reltime*TESalbs(lonsup,latinf,tsup)
+  val(3)=(1.-reltime)*TESalbs(lonsup,latsup,tinf) &
+         +reltime*TESalbs(lonsup,latsup,tsup)
+  val(4)=(1.-reltime)*TESalbs(loninf,latsup,tinf) &
+         +reltime*TESalbs(loninf,latsup,tsup)
+endif ! of if (icap.eq.1)
+
+! 5. Use bilinear interpolation to compute albedo
+alb=(1.-rellon)*(1.-rellat)*val(1) &
+    +rellon*(1.-rellat)*val(2) &
+    +rellon*rellat*val(3) &
+    +(1.-rellon)*rellat*val(4)
+
+! 6. Apply coefficient to interpolated TES albedo
+if (icap.eq.1) then
+  alb=alb*TESice_Ncoef
+else
+  alb=alb*TESice_Scoef
+endif ! of if (icap.eq.1)
+
+end subroutine TES_icecap_albedo
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blackl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blackl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blackl.F	(revision 46)
@@ -0,0 +1,20 @@
+      subroutine blackl(blalong,blat,blae)
+c.......................................................................
+      implicit double precision (a-h,o-z)
+c.......................................................................
+c.....donnees de fond
+      sigma=5.6693d-08
+      pi=datan(1.d0)*4.d0
+      c0=2.9979d+08
+      h=6.6262d-34
+      cbol=1.3806d-23
+      rind=1.d0
+      c=c0/rind
+      c1=h*(c**2)
+      c2=h*c/cbol
+c.....fin de donnees de fond
+c.......................................................................
+      blae=2.d0*pi*c1/blalong**5/(dexp(c2/blalong/blat)-1.d0)
+c.......................................................................
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blendrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blendrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/blendrad.F	(revision 46)
@@ -0,0 +1,60 @@
+      subroutine blendrad(ngrid, nlayer, pplay,
+     &                    zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+c
+c  Combine radiative tendencies.  LTE contributions (zdtsw and zdtlw)
+c  have been calculated for the first NLAYLTE layers, zdtnirco2 and
+c  zdtnlte have been calculated for all nlayer layers (but zdtnlte may
+c  be zero low down).  zdtlw is phased out in favour of zdtnlte with
+c  height; zdtsw is also phased out to remove possible spurious heating
+c  at low pressures.  The pressure at which the transition occurs and
+c  the scale over which this happens are set in the nlteparams.h file.
+c  Above layer NLAYLTE the tendency is purely the sum of NLTE contributions.
+c  (Note : nlaylte is calculated by "nlthermeq" and stored in common "yomlw.h")
+c  Stephen Lewis 6/2000 FF 
+c
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+
+c     Input:
+      integer ngrid, nlayer
+      real pplay(ngrid, nlayer)
+      real zdtlw(ngrid, nlayer)
+      real zdtsw(ngrid, nlayer)
+      real zdtnirco2(ngrid, nlayer)
+      real zdtnlte(ngrid, nlayer)
+c
+c     Output:
+      real dtrad(ngrid, nlayer)
+c
+c     Local:
+      integer l, ig
+      real alpha
+c
+c     This is split into two loops to minimize number of calculations,
+c     but for vector machines it may be faster to perform one big
+c     loop from 1 to nlayer and remove the second loop.
+c
+c     Loop over layers for which zdtsw/lw have been calculated.
+      do l = 1,nlaylte 
+         do ig = 1, ngrid
+c           alpha is actually 0.5*(1+tanh((z-ztrans)/zw))
+c           written here in a simpler form, with z=-ln(p) and zwi=2/zw
+            alpha = 1./(1.+(pplay(ig,l)/ptrans)**zwi)
+            dtrad(ig,l) = (1.-alpha)*(zdtsw(ig,l)+zdtlw(ig,l))
+     &                  + zdtnirco2(ig,l) + alpha*zdtnlte(ig,l)
+         enddo
+      enddo
+c
+c     Faster loop over any remaining layers.
+      do l = nlaylte+1, nlayer
+         do ig = 1, ngrid
+            dtrad(ig,l) = zdtnirco2(ig,l) + zdtnlte(ig,l)
+         enddo
+      enddo
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro.F	(revision 46)
@@ -0,0 +1,205 @@
+      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw) 
+
+
+
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call SUBROUTINE drag_noro 
+c   Interface for sub-grid scale orographic scheme
+c   The purpose of this subroutine is
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h.
+c
+c   author:   
+c   ------
+c           Christophe Hourdin/ Francois Forget
+c
+c   changes:
+c   -------
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   ptimestep             Physical timestep (s)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature  (K)
+c   pu(ngrid,nlayer)       zonal wind (m s-1)
+c   pv(ngrid,nlayer)       meridional wind (m s-1)
+c
+c   output:
+c   -------
+c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
+c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
+c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
+c
+c
+c
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "surfdat.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer  
+
+      real ptimestep
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
+      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      REAL sigtest(nlayermx+1)
+      INTEGER igwd,igwdim,itest(ngridmx)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+      INTEGER l,ig
+      INTEGER jd,ig0,nd
+
+      REAL zulow(ngridmx),zvlow(ngridmx)
+      REAL zustr(ngridmx),zvstr(ngridmx)
+
+      REAL zplev(ndomainsz,nlayermx+1)
+      REAL zplay(ndomainsz,nlayermx)
+      REAL zt(ndomainsz,nlayermx)
+      REAL zu(ndomainsz,nlayermx)
+      REAL zv(ndomainsz,nlayermx)
+      INTEGER zidx(ndomainsz)
+      REAL zzdtgw(ndomainsz,nlayermx)
+      REAL zzdugw(ndomainsz,nlayermx)
+      REAL zzdvgw(ndomainsz,nlayermx)
+
+      logical ll
+
+
+c   local saved variables
+c   ---------------------
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         do l=1,nlayermx+1
+           sigtest(l)=pplev(1,l)/pplev(1,1)
+         enddo
+         call sugwd(nlayermx,sigtest)
+
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, meme pour drag_noro '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+
+         firstcall=.false.
+      END IF
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+          nd=ngridmx-ig0
+        else
+          nd=ndomainsz
+        endif
+
+c       Detecting points concerned by the scheme
+c       ----------------------------------------
+
+        igwd=0
+        DO ig=ig0+1,ig0+nd
+          itest(ig)=0
+          ll=zstd(ig).gt.50.0
+          IF(ll) then
+            itest(ig)=1
+            igwd=igwd+1
+            zidx(igwd)=ig - ig0
+          ENDIF
+        ENDDO
+        IGWDIM=MAX(1,IGWD)
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlayer+1
+          do ig = 1,nd
+           zplev(ig,l) = pplev(ig0+ig,l)
+          enddo
+        enddo
+
+        do l=1,nlayer
+          do ig = 1,nd
+            zplay(ig,l) = pplay(ig0+ig,l)
+            zt(ig,l) = pt(ig0+ig,l)
+            zu(ig,l) = pu(ig0+ig,l)
+            zv(ig,l) = pv(ig0+ig,l)
+          enddo
+        enddo
+
+c       Calling gravity wave and subgrid scale topo parameterization
+c       -------------------------------------------------------------
+
+        call drag_noro (nd,nlayer,ptimestep,zplay,zplev,
+     e        zstd(ig0+1),zsig(ig0+1),zgam(ig0+1),zthe(ig0+1),
+     e        igwd,igwdim,zidx,itest(ig0+1),
+     e        zt, zu, zv,
+     s        zulow(ig0+1),zvlow(ig0+1),zustr(ig0+1),zvstr(ig0+1),
+     s        zzdtgw,zzdugw,zzdvgw)
+
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+c       (and devide by ptimestep -> true tendancies)
+
+        do l=1,nlayer
+         do ig = 1,nd
+          pdtgw(ig0+ig,l) = zzdtgw(ig,l)/ptimestep
+          pdugw(ig0+ig,l) = zzdugw(ig,l)/ptimestep
+          pdvgw(ig0+ig,l) = zzdvgw(ig,l)/ptimestep
+         enddo
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/calldrag_noro_SP36.old	(revision 46)
@@ -0,0 +1,143 @@
+      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw) 
+
+
+
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call SUBROUTINE drag_noro 
+c   Interface for sub-grid scale orographic scheme
+c
+c   author:   
+c   ------
+c           Christophe Hourdin/ Francois Forget
+c
+c   changes:
+c   -------
+c   > J.-B. Madeleine 09W30
+c   Removed the variable's splitting, which is now obsolete.
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   ptimestep             Physical timestep (s)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature  (K)
+c   pu(ngrid,nlayer)       zonal wind (m s-1)
+c   pv(ngrid,nlayer)       meridional wind (m s-1)
+c
+c   output:
+c   -------
+c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
+c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
+c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
+c
+c
+c
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer  
+
+      real ptimestep
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
+      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      REAL sigtest(nlayermx+1)
+      INTEGER igwd,igwdim,itest(ngridmx)
+
+      INTEGER l,ig
+
+      REAL zulow(ngridmx),zvlow(ngridmx)
+      REAL zustr(ngridmx),zvstr(ngridmx)
+
+      INTEGER zidx(ngridmx)
+
+      logical ll
+
+
+c   local saved variables
+c   ---------------------
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         do l=1,nlayermx+1
+           sigtest(l)=pplev(1,l)/pplev(1,1)
+         enddo
+         call sugwd(nlayermx,sigtest)
+         firstcall=.false.
+      END IF
+
+c       Detecting points concerned by the scheme
+c       ----------------------------------------
+
+        igwd=0
+        DO ig=1, ngrid
+          itest(ig)=0
+          ll=zstd(ig).gt.50.0
+          IF(ll) then
+            itest(ig)=1
+            igwd=igwd+1
+            zidx(igwd)=ig
+          ENDIF
+        ENDDO
+        IGWDIM=MAX(1,IGWD)
+
+c       Calling gravity wave and subgrid scale topo parameterization
+c       -------------------------------------------------------------
+
+        call drag_noro (ngrid,nlayer,ptimestep,pplay,pplev,
+     e            zstd,zsig,zgam,zthe,
+     e            igwd,igwdim,zidx,itest,
+     e            pt, pu, pv,
+     s            zulow,zvlow,zustr,zvstr,
+     s            pdtgw,pdugw,pdvgw)
+
+
+c       Dividing by ptimestep (true tendancies)
+c       ---------------------------------------
+
+        do l=1,nlayer
+         do ig = 1, ngrid
+          pdtgw(ig,l) = pdtgw(ig,l)/ptimestep
+          pdugw(ig,l) = pdugw(ig,l)/ptimestep
+          pdvgw(ig,l) = pdvgw(ig,l)/ptimestep
+         enddo
+        enddo
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callkeys.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callkeys.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callkeys.h	(revision 46)
@@ -0,0 +1,61 @@
+!
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+      COMMON/callkeys/callrad,calldifv,calladj,callcond,callsoil,       &
+     &   season,diurnal,iradia,lwrite,calllott                          &
+     &   ,iaervar,iddist,topdustref,callstats,calleofdump               &
+     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+     &        calleuv,callmolvis,callmoldiff,thermochem                 &
+     &   , solarcondate, thermoswater                                   &
+     &   , semi                                                         &
+     &   , callemis                                                     &
+     &   , callg2d                                                      &
+     &   , linear                                                       &
+     &   , ilwd                                                         &
+     &   , ilwb                                                         &
+     &   , ilwn                                                         &
+     &   , ncouche                                                      &
+     &   , alphan                                                       &
+     &   , rayleigh                                                     &
+     &   , tracer                                                       &
+     &   , dustbin,active,doubleq,lifting,callddevil,scavenging         &
+     &   , sedimentation,activice,water,caps                            &
+     &   , photochem,nqchem_min                                         
+
+      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 iddist
+      integer iaervar
+      integer iradia
+      integer ilwd
+      integer ilwb
+      integer ilwn
+      integer ncouche
+
+      logical rayleigh
+      logical tracer
+      integer dustbin
+      logical active,doubleq,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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite.F	(revision 46)
@@ -0,0 +1,486 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,rice,nuice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c      3) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      4) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   This 3D size distribution is loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n,ich,iaer
+      INTEGER jd,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      real znetrad(ndomainsz,nflev)
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
+
+      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                pplev,pplay,
+     &                rice,nuice,
+     &                reffrad,nueffrad)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &      tauref,tau,aerosol,reffrad,
+     &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+           do iaer = 1, naerkind
+             do ich = 1, nsun
+               zQVISsQREF3d(ig,l,ich,iaer) = 
+     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaVIS3d(ig,l,ich,iaer) = 
+     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+               zgVIS3d(ig,l,ich,iaer) = 
+     &                           gVIS3d(ig0+ig,l,ich,iaer)
+             enddo
+             do ich = 1, nir
+               zQIRsQREF3d(ig,l,ich,iaer) = 
+     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaIR3d(ig,l,ich,iaer) = 
+     &                           omegaIR3d(ig0+ig,l,ich,iaer)
+               zgIR3d(ig,l,ich,iaer) = 
+     &                           gIR3d(ig0+ig,l,ich,iaer)
+             enddo
+           enddo
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
+         ENDDO
+        ENDDO
+
+        DO ig=1, nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad
+     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev,
+     S     cste_mars, zalbedo,
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw,
+     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
+
+c       ------------------------------------------------------------
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callradite_SP36.old	(revision 46)
@@ -0,0 +1,368 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,rice,nuice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      3) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   This 3D size distribution is loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 09W30
+c
+c   Removed the variable's splitting, which is now obsolete.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+      REAL dp(ngrid,nflev)
+      REAL dt0(ngrid)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      REAL netrad(ngrid,nflev) 
+      REAL fluxd_sw(ngrid,nflev+1,2)
+      REAL fluxu_sw(ngrid,nflev+1,2)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                pplev,pplay,
+     &                rice,nuice,
+     &                reffrad,nueffrad)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &      tauref,tau,aerosol,reffrad,
+     &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+
+        do l=1,nlaylte
+         do ig = 1, ngrid
+c         Thickness of each layer (Pa) :
+          dp(ig,l)= pplev(ig,l) - pplev(ig,l+1)
+         enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1, ngrid
+              ptlev(ig,1)=pt(ig,1)+
+     s        (pplev(ig,1)-pplay(ig,1))*
+     s        (pt(ig,1)-pt(ig,2))/(pplay(ig,1)-pplay(ig,2))
+
+              dt0(ig) = tsurf(ig) - ptlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, ngrid
+               ptlev(ig,l)=0.5*(pt(ig,l-1)+pt(ig,l))
+         ENDDO
+        ENDDO
+
+        DO ig=1, ngrid
+           ptlev(ig,nlaylte+1)=pt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (icount,ngrid,nflev
+     .        ,dp,dt0,emis,pplev,ptlev,pt
+     .        ,aerosol,dtlw
+     .        ,fluxsurf_lw,fluxtop_lw
+     .        ,netrad
+     &        ,QIRsQREF3d,omegaIR3d,gIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( ngrid, nflev, 
+     S     cste_mars, albedo, 
+     S     mu0, dp, pplev, aerosol, fract,
+     S     dtsw, fluxd_sw, fluxu_sw,
+     &     QVISsQREF3d,omegaVIS3d,gVIS3d)
+
+c       ------------------------------------------------------------
+
+        do ig = 1, ngrid
+          fluxsurf_sw(ig,1) = fluxd_sw(ig,1,1)
+          fluxsurf_sw(ig,2) = fluxd_sw(ig,1,2)
+          fluxtop_sw(ig,1) = fluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig,2) = fluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim.F	(revision 46)
@@ -0,0 +1,158 @@
+      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt, rnuclei, rice,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c      Sedimentation of the  Martian aerosols
+c      depending on their density and radius
+c
+c      F.Forget 1999
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+#include "callkeys.h"
+
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid              ! number of horizontal grid points
+      INTEGER nlay               ! number of atmospheric layers
+      REAL ptimestep             ! physics time step (s)
+      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+c    Aerosol radius provided by the water ice microphysical scheme:
+      REAL rnuclei(ngrid,nlay)   ! Prescribed dust radius in each layer (m)
+      REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+
+c    Traceurs :
+      integer nq             ! number of tracers
+      real pq(ngrid,nlay,nq)  ! tracers (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, iq
+
+      real zqi(ngridmx,nlayermx) ! to locally store tracers
+      real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
+      real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
+      real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
+c      real dens(ngridmx,nlayermx) ! Mean density of the ice part. accounting for dust core
+      real rfall(ngridmx,nlayermx)
+
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans callsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+      
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+c
+c     Calcul preliminaires  de caracteristiques des couches
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g 
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+      do iq=1,nq
+        if(radius(iq).gt.1.e-9) then   ! no sedim for gaz (defined by radius=0)
+
+c         On "update" la valeur de q apres les autres parametrisations
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          do l=1,nlay
+            do ig=1,ngrid
+              ! store locally updated tracers
+              zqi(ig,l)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+!              if (iceparty.and.iq.eq.nq-1) then
+              if (water.and.(iq.eq.igcm_h2o_ice)) then
+c               On affecte un rayon moyen aux poussieres a chaque altitude du type :
+c               r(z)=r0*exp(-z/H) avec r0=0.8 micron et H=18 km.
+c               ''''''''''''''''''''''''''''''''''''''''''''''''
+                rfall(ig,l)=max( rice(ig,l)*1.5,rnuclei(ig,l) )
+c modif FranckMM pour ameliorer cycle H2O: rfall= 20 microns
+                rfall(ig,l)=min(rfall(ig,l),1.e-4)
+!mars commente pour l'instant               rfall(ig,l)=20.e-6
+              endif
+            enddo
+          enddo ! of do l=1,nlay
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!          if(iceparty.and.iq.eq.nq-1) then
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+     &      pplev,masse,epaisseur,pt,rfall,rho_q(iq),zqi,wq)
+          else
+            call newsedim(ngrid,nlay,1,ptimestep,
+     &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),zqi,wq)
+          endif
+
+c         Calcul des tendances
+c         ~~~~~~~~~~~~~~~~~~~~
+          do ig=1,ngrid 
+!            if(iceparty.and.iq.eq.nq-1) then
+!                pdqs_sed(ig,nq) = wq(ig,1)/ptimestep 
+!            else
+!                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+!            endif
+! Temporary: surface ice is qsurf(igcm_h2o_vap) ! no more
+!            if(iceparty.and.(iq.eq.igcm_h2o_ice)) then
+!                pdqs_sed(ig,igcm_h2o_vap) = wq(ig,1)/ptimestep 
+!            else
+!                pdqs_sed(ig,iq) = wq(ig,1)/ptimestep 
+!            endif
+! Ehouarn: with new way of tracking tracers by name, it should now simply be
+            pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
+          end do
+
+          DO l = 1, nlay
+            DO ig=1,ngrid
+c	      zqi(ig,l)=max(zqi(ig,l), 1.e-10)
+              pdqsed(ig,l,iq)=(zqi(ig,l)-
+     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+
+        endif ! of if(radius(iq).gt.1.e-9)
+      enddo ! of do iq=1,nq
+ 
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim2q.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim2q.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/callsedim2q.F	(revision 46)
@@ -0,0 +1,330 @@
+      SUBROUTINE callsedim2q(ngrid,nlay, ptimestep,
+     $                pplev,zlev, pt,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Sedimentation of the  Martian dust 
+c      using method with mass (iq=1) and number(iq=2) mixing ratio
+c
+c      F.Forget 1999
+c
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid              ! number of horizontal grid points
+      INTEGER nlay               ! number of atmospheric layers
+      REAL ptimestep             ! physics time step (s)
+      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
+      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
+      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
+
+
+c    Traceurs :
+      integer nq                 ! number of tracers
+      real pq(ngrid,nlay,nq)     ! tracer (kg/kg)
+      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
+      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      INTEGER iq
+      real zq(ngridmx,nlayermx,2) ! to locally store dust tracers
+      real masse(ngridmx,nlayermx)      ! Layer mass (kg.m-2)
+      real epaisseur(ngridmx,nlayermx)  ! Layer thickness (m)
+      real wq(ngridmx,nlayermx+1)       ! moved tracer mass (kg.m-2)
+      real r0(ngridmx,nlayermx)         ! geometric mean radius (m)
+
+
+c     Discretisation en taille:
+c     ~~~~~~~~~~~~~~
+c       1) Discretisation pour representer la variation de Vitesse de chute
+      integer nr,ir
+      parameter (nr=7)   ! nombre de rayon pour le calcul du transport
+      real rd(nr),qr(ngridmx,nlayermx,nr)
+      real rdi(nr+1)    ! extreme and intermediate radii
+      real Sq(ngridmx,nlayermx)
+      real rdmin,rdmax,rdimin,rdimax
+      data rdmin/1.e-7/
+      data rdmax/30.e-6/
+      data rdimin/1.e-10/
+      data rdimax/1e-4/
+      save rd, rdi
+
+c       2) Sous discretisation pour bien integrer la loi lognormale
+c          (calcul de q pour chaque gamme de rayon rd)
+
+      integer nint, iint   
+      parameter (nint=4)  ! nombre de point entre chaque rayon rdi
+      real rr(nint,nr)
+      save rr
+      
+      real reff(ngridmx,nlayermx,2)  ! for diagnostic only
+      
+      INTEGER idust_mass   ! index of tracer containing dust mass mix. ratio
+      INTEGER idust_number ! index of tracer containing dust number mix. ratio
+      INTEGER niq(2)       ! to store the indexes corresponding to dust
+      SAVE idust_mass,idust_number,niq
+
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            Print*,'STOP dans coefdifv'
+            Print*,'probleme de dimensions :'
+            Print*,'ngrid  =',ngrid
+            Print*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+ 
+         do ir=1,nr
+             rd(ir)= rdmin*(rdmax/rdmin)**(float(ir-1)/float(nr-1))
+c            rd(ir) = rdmin + (float(ir-1)/float(nr-1))*(rdmax-rdmin)
+         end do
+         rdi(1)=rdimin
+         do ir=2,nr
+           rdi(ir)= sqrt(rd(ir-1)*rd(ir))
+         end do
+         rdi(nr+1)=rdimax
+
+         do ir=1,nr
+           do iint=1,nint
+             rr(iint,ir)=
+     &       rdi(ir)*(rdi(ir+1)/rdi(ir))**(float(iint-1)/float(nint-1))
+c             write(*,*) rr(iint,ir)
+           end do
+         end do
+
+      ! identify tracers corresponding to mass mixing ratio and
+      ! number mixing ratio
+        idust_mass=0      ! dummy initialization
+        idust_number=0    ! dummy initialization
+        
+        do iq=1,nq
+          if (noms(iq).eq."dust_mass") then
+            idust_mass=iq
+            niq(1)=idust_mass
+          endif
+          if (noms(iq).eq."dust_number") then
+            idust_number=iq
+            niq(2)=idust_number
+          endif
+        enddo
+        
+        ! check that we did find the tracers
+        if ((idust_mass.eq.0).or.(idust_number.eq.0)) then
+          write(*,*) 'callsedim2q: error! could not identify tracers'
+          write(*,*) '         for dust mass and number mixing ratio' 
+          stop
+        endif
+        
+      ENDIF ! of IF (firstcall)
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q apres les autres parametrisations
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,2
+        do l=1,nlay
+          do ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep
+! unrolling loop in iq would amount to:
+            ! dust mass mixing ratio
+!            zq(ig,l,1)=pq(ig,l,idust_mass)
+!     &                     +pdqfi(ig,l,idust_mass)*ptimestep
+            ! dust number mixing ratio
+!            zq(ig,l,2)=pq(ig,l,idust_number)
+!     &                     +pdqfi(ig,l,idust_number)*ptimestep
+          enddo
+        enddo
+      enddo
+
+
+c    Calcul preliminaires  de caracteristiques des couches
+c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c    Masse (kg.m-2), epaisseur(m), temps de traversee (s)  etc...
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+        end do
+      end do
+
+
+c     Calcul de la distribution de taille
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      do  l=1,nlay
+         do ig=1, ngrid
+              r0(ig,l)=
+     &        (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+              r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+         end do
+      end do
+
+      DO iq=1,2  ! LOOP on Mass (iq=1) then Number(iq=2) mixing ratio
+
+c        Calcul du rapport de melange pour les nir tailles considerees
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          call zerophys(ngridmx*nlayermx, Sq)
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+c                **************** nouvelle methode :
+c                Calcul de q pour chaque gamme de rayon rd
+c                Sous discretisation pour bien integrer la loi lognormale
+c                (Methode des trapezes)
+                 qr(ig,l,ir)=0.5*(rr(2,ir)-rr(1,ir))*
+     &             (rr(1,ir)**(5-3*iq))*
+     &             exp(-(log(rr(1,ir)/r0(ig,l)))**2/(2*varian**2))
+                 do iint=2,nint-1
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(iint+1,ir)-rr(iint-1,ir))*
+     &             (rr(iint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(iint,ir)/r0(ig,l)))**2/(2*varian**2))
+                 end do
+                   qr(ig,l,ir)=qr(ig,l,ir) +
+     &             0.5*(rr(nint,ir)-rr(nint-1,ir))*
+     &             (rr(nint,ir)**(5-3*iq))*
+     &             exp(-(log(rr(nint,ir)/r0(ig,l)))**2/(2*varian**2))
+
+c                **************** Methode simple BUGGEE
+c                qr(ig,l,ir)=(rd(ir)**(5-3*iq))*
+c    &           exp( -(log(rd(ir)/r0(ig,l)))**2 / (2*varian**2) )
+c                ******************************
+                 Sq(ig,l)=Sq(ig,l)+qr(ig,l,ir) 
+              enddo
+            enddo
+          enddo
+          do ir=1,nr
+            do l=1,nlay
+              do ig=1,ngrid
+                 qr(ig,l,ir)= zq(ig,l,iq)* qr(ig,l,ir)/Sq(ig,l)
+              enddo
+            enddo
+c          write(123,*) rd(ir)*1.e6, qr(1,10,ir)
+          enddo
+
+c         Calcul du transport par sedimentation pour chaque traceur
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+          call zerophys(ngridmx*nlayermx,zq(1,1,iq))
+          call zerophys(ngridmx*nlayermx,pdqs_sed(1,niq(iq)))
+
+c         write(*,*)
+c         if(iq.eq.1) write(*,*) '5 fois  wq(6), wq(7), q(6)'
+          
+          do ir=1,nr
+             call newsedim(ngrid,nlay,1,ptimestep,
+     &       pplev,masse,epaisseur,pt,rd(ir),rho_dust,qr(1,1,ir),wq)
+
+c            Calcul des tendances
+c            ~~~~~~~~~~~~~~~~~~~~
+             do ig=1,ngrid
+               pdqs_sed(ig,niq(iq)) = pdqs_sed(ig,niq(iq))
+     &                                + wq(ig,1)/ptimestep
+             end do
+             DO l = 1, nlay
+               DO ig=1,ngrid
+                 zq(ig,l,iq)=zq(ig,l,iq)+qr(ig,l,ir)
+               ENDDO
+             ENDDO
+c         if(iq.eq.1) write(*,*) 'callsed: wq(6), wq(7), q(6)',
+c    &               wq(1,6),wq(1,7),qr(1,6,ir)
+
+c               if(iq.eq.1)write(*,*)'R=', rd(ir)*1.e6
+c               write(*,*)
+          enddo ! of do ir=1,nr
+
+          do l = 1, nlay
+            do ig=1,ngrid
+              pdqsed(ig,l,niq(iq))=(zq(ig,l,iq)-
+     $             (pq(ig,l,niq(iq))+pdqfi(ig,l,niq(iq))*ptimestep)
+     &                              )/ptimestep
+            enddo
+          enddo
+
+c     ***** Diagnostique *****************
+c         call zerophys(ngridmx*nlayermx,reff(1,1,iq))
+c         do ir=1,nr
+c           do l = 1, nlay
+c             do ig=1,ngrid
+c              if(iq.eq.1) then 
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)/rd(ir)
+c              else
+c               reff(ig,l,iq)=reff(ig,l,iq) + qr(ig,l,ir)*log(rd(ir))
+c              endif
+c             enddo
+c           enddo
+c         enddo
+c         do l = 1, nlay
+c           do ig=1,ngrid
+c            if(iq.eq.1) then 
+c             reff(ig,l,iq)=zq(ig,l,iq)/reff(ig,l,iq)
+c            else
+c             reff(ig,l,iq)=exp(reff(ig,l,iq)/zq(ig,l,iq))
+c            endif
+c           enddo
+c         enddo
+c     **** FIN Diagnostique *****************
+
+      enddo  ! end loop on iq=1,2
+
+
+
+c ********************************************
+c     Diagnostique
+c     if(ngrid.eq.1) then
+c      do  l=1,nlay
+c       do ig=1, ngrid
+c         r0(ig,l)=
+c    &    (r3n_q*zq(ig,l,1)/max(zq(ig,l,min(2,nq)),0.01))**(1./3.)
+c         r0(ig,l)=min(max(r0(ig,l),1.e-10),500.e-6)
+c
+c         write(*,*)'l,r0, r02 ', l, r0(ig,l),reff(ig,l,1)*0.3626
+c    &    ,reff(ig,l,2)
+c    &    ,r0(ig,l)/(reff(ig,l,1)*0.3626) 
+c
+c       end do
+c      end do
+c      CALL writeg1d(ngrid,nlay,r0,'r0','m')
+c     end if
+c ********************************************
+
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/co2snow.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/co2snow.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/co2snow.F	(revision 46)
@@ -0,0 +1,140 @@
+      SUBROUTINE co2snow (ngrid,nlayer,ptimestep,emisref,condsub,pplev,
+     &        pcondicea,pcondices,pfallice,pemisurf)
+
+       IMPLICIT NONE
+
+c=======================================================================
+c     Program for simulate the impact of the CO2 snow fall on
+c     the surface infrared emission (emissivity)  and on 
+c     the airborne dust
+c     F.Forget 1996
+c=======================================================================
+
+c Declarations
+c ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "callkeys.h"
+
+c     input
+c     -----
+
+      INTEGER ngrid,nlayer
+      REAL ptimestep , emisref(ngrid) ! grd or ice  emissivity without snow
+      logical condsub(ngrid)
+
+      REAL pplev(ngrid,nlayer+1)
+      REAL pcondicea(ngrid,nlayer), pcondices(ngrid)
+      REAL pfallice(ngrid,nlayer+1)
+
+c     output
+c     ------
+
+      REAL pemisurf(ngrid)
+
+c     local
+c     -----
+      integer ig , l , icap
+
+      REAL zdemisurf ,dtemis
+      REAL sumdaer
+
+c     saved
+c     -----
+      REAL Kscat(2), scaveng
+      LOGICAL firstcall
+      SAVE firstcall
+      save Kscat , scaveng
+      DATA firstcall/.true./
+
+c --------------
+c Initialisation
+c --------------
+
+      if (firstcall) then
+
+c   Kscat : coefficient for decreasing the surface emissivity
+c           =(0.001/3.)*alpha/iceradius ,
+c           with 0.3< alpha < 0.6, set to 0.45 (coeff from emis = f (tau))
+c           and iceradius the mean radius of the
+c           scaterring particles  (200.e-6<iceradius<10.e-6)
+
+            Kscat(1)=(0.001/3.)*0.45/iceradius(1)
+            Kscat(2)=(0.001/3.)*0.45/iceradius(2)
+
+c          Scavenging Ratio (dust concentration in the air / in the snow)
+           scaveng = 100.0
+           
+c          Collision Scavenging coefficient  (m2.kg-1)
+c          Csca  = 2.3  ! not used yet !!!!!!!!!!!
+           firstcall = .false.
+
+      end if
+
+
+c     LOOP on grid points
+c     -------------------
+      do ig=1,ngrid 
+         if (condsub(ig)) then
+
+c         IF (scavenging) then
+c          Airborne Dust 
+c          -------------
+c          sumdaer=0.
+c          do l=nlayer, 1, -1
+c             pdaerosol(ig,l)= -paerosol(ig,l,1)*
+c    &              (1-exp(-scaveng*pcondicea(ig,l)*ptimestep*g/
+c    &               (pplev(ig,l)-pplev(ig,l+1))))/ptimestep  
+
+c    &           - Csca*paerosol(ig,l,1) ! Scavenging by collision
+c    &           * 0.5*(pfallice(ig,l)) ! not included
+
+c             test to avoid releasing to much dust when subliming:
+c             if(pdaerosol(ig,l).gt.-sumdaer)pdaerosol(ig,l)=-sumdaer 
+c             sumdaer=sumdaer + pdaerosol(ig,l)
+
+c            if (-pdaerosol(ig,l)*ptimestep.gt.paerosol(ig,l,1)) then
+c                write(*,*) 'ds co2snow: aerosol < 0.0 !!!'
+c                write(*,*) 'ig =' , ig
+c            end if
+c          end do
+c         END IF
+
+c          Surface emissivity
+c          ------------------
+c   dtemis: Time scale for increasing the ice emissivity
+
+           IF(ig.GT.ngrid/2+1) THEN
+              icap=2
+           ELSE
+              icap=1
+           ENDIF
+
+           zdemisurf = 
+     &    (emisref(ig)-pemisurf(ig))/(dtemisice(icap)*daysec) 
+c Using directly the diferential equation:
+c    &       -Kscat(icap)*emisref(ig)*
+c    &      (pemisurf(ig)/emisref(ig))**4 *pfallice(ig,1) 
+c Using an integrated form for numerical safety instead
+     & +(emisref(ig)* ((pemisurf(ig)/emisref(ig))**(-3)+3.*Kscat(icap)*
+     & pfallice(ig,1)*ptimestep)**(-1/3.) -pemisurf(ig))/ptimestep   
+
+
+           pemisurf(ig) = pemisurf(ig) + zdemisurf*ptimestep 
+
+           if (pemisurf(ig).lt.0.1) then
+                 write(*,*) 'ds co2snow: emis < 0.1 !!!'
+                 write(*,*) 'ig =' , ig
+                 write(*,*)'pemisurf(ig)',pemisurf(ig)
+                 write(*,*) 'zdemisurf*ptimestep',zdemisurf*ptimestep
+           end if
+         else
+           pemisurf(ig) = emisref(ig)
+         end if
+      end do
+
+      return
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comcstfi.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comcstfi.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comcstfi.h	(revision 46)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+! INCLUDE "comcstfi.h"
+
+      common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
+      real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comdiurn.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comdiurn.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comdiurn.h	(revision 46)
@@ -0,0 +1,5 @@
+      COMMON/comdiurn/ldiurn,
+     s     sinlon(ngridmx),coslon(ngridmx),
+     s     sinlat(ngridmx),coslat(ngridmx)
+      REAL sinlon,coslon,sinlat,coslat
+      LOGICAL ldiurn
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comg1d.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comg1d.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comg1d.h	(revision 46)
@@ -0,0 +1,59 @@
+c.......................................................................
+c  le COMMON pour GRADS-1D
+c  (Utilise pour les sorties format Grads dans la version 1D du modele)
+c
+c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+c
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+c
+c         * g1d_nlayer     ---> nombre de couches verticales
+c         * g1d_nomfich    ---> nom du fichier grads
+c         * g1d_unitfich   ---> code du fichier grads
+c         * g1d_nomctl     ---> nom du fichier ctl
+c         * g1d_unitctl    ---> code du fichier ctl
+c         * g1d_premier    ---> variable logique pour dire si le fichier
+c                               est deja ouvert
+c         * g1d_irec       ---> indice de derniere ecriture
+c         * g1d_nvar       ---> nombre de variables deja definies a la
+c                               derniere ecriture
+c         * g1d_nomvar     ---> noms des vecteurs existants
+c         * g1d_dimvar     ---> taille des vecteurs
+c         * g1d_titrevar   ---> titres des vecteurs
+c         * g1d_tmp1       ---> caractere 
+c         * g1d_tmp2       ---> caractere 
+c
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+c
+      COMMON/COMG1DI/g1d_nlayer
+     &             ,g1d_unitfich
+     &             ,g1d_unitctl
+     &             ,g1d_irec
+     &             ,g2d_irec
+     &             ,g2d_appel
+     &             ,g1d_nvar
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
+     &             ,g1d_nomfich
+     &             ,g1d_nomctl
+     &             ,g1d_nomvar(0:g1d_nvarmx)
+     &             ,g1d_titrevar(0:g1d_nvarmx)
+     &             ,g1d_tmp1
+     &             ,g1d_tmp2
+      COMMON/COMG1DL/g1d_premier
+     &             ,g2d_premier
+c
+c.......................................................................
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comgeomfi.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comgeomfi.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comgeomfi.h	(revision 46)
@@ -0,0 +1,4 @@
+      COMMON/comgeomfi1/long(ngridmx),lati(ngridmx),area(ngridmx)
+      COMMON/comgeomfi2/ totarea
+
+      REAL long,lati,area,totarea
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comorbit.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comorbit.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comorbit.h	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'comorbit.h'
+
+      COMMON/comorbit/aphelie,periheli,year_day,
+     $       peri_day,timeperi,obliquit,
+     $       e_elips,p_elips,unitastr,pi
+
+      REAL aphelie,periheli,year_day,
+     $  peri_day,timeperi,obliquit,
+     $  e_elips,p_elips,unitastr,pi
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsaison.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsaison.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsaison.h	(revision 46)
@@ -0,0 +1,11 @@
+c-----------------------------------------------------------------------
+c   INCLUDE saison.h
+
+      COMMON/saison/callsais,isaison,dist_sol,declin,
+     $             mu0(ngridmx),fract(ngridmx)
+
+      INTEGER isaison
+      LOGICAL callsais
+      REAL dist_sol,declin,mu0,fract
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsoil.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsoil.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/comsoil.h	(revision 46)
@@ -0,0 +1,7 @@
+      common/comsoil1/layer(nsoilmx),mlayer(0:nsoilmx-1)
+      common/comsoil2/inertiedat(ngridmx,nsoilmx),volcapa
+
+      real layer      ! soil layer depths
+      real mlayer     ! soil mid-layer depths
+      real inertiedat ! soil thermal inertia
+      real volcapa    ! soil volumetric heat capacity
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/convadj.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/convadj.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/convadj.F	(revision 46)
@@ -0,0 +1,350 @@
+      SUBROUTINE convadj(ngrid,nlay,nq,ptimestep,
+     S                   pplay,pplev,ppopsk,
+     $                   pu,pv,ph,pq,
+     $                   pdufi,pdvfi,pdhfi,pdqfi,
+     $                   pduadj,pdvadj,pdhadj,
+     $                   pdqadj)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   ajustement convectif sec
+c   on ajoute les tendances pdhfi au profil pdh avant l'ajustement
+c   SPECIAL VERSION : if one tracer is CO2, take into account the
+c   Molecular mass variation (e.g. when CO2 condense) to trigger
+c   convection  F. Forget 01/2005
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
+      REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
+
+c    Traceurs :
+      integer nq
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+      real pdqadj(ngrid,nlay,nq)
+
+
+c   local:
+c   ------
+
+      INTEGER ig,i,l,l1,l2,jj
+      INTEGER jcnt, jadrs(ngridmx)
+
+      REAL sig(nlayermx+1),sdsig(nlayermx),dsig(nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL zu2(ngridmx,nlayermx),zv2(ngridmx,nlayermx)
+      REAL zh2(ngridmx,nlayermx), zhc(ngridmx,nlayermx)
+      REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+      
+
+c    Traceurs :
+      INTEGER iq,ico2
+      save ico2
+      REAL zq(ngridmx,nlayermx,nqmx), zq2(ngridmx,nlayermx,nqmx)
+      REAL zqm(nqmx),zqco2m
+      real m_co2, m_noco2, A , B
+      save A, B
+c    Temporaire (for diagnostic)
+c      REAL diag_alpha(ngridmx)
+
+      real mtot1, mtot2 , mm1, mm2
+       integer l1ref, l2ref
+      LOGICAL vtest(ngridmx),down,firstcall
+      save firstcall
+      data firstcall/.true./
+
+      EXTERNAL SCOPY
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+      IF (firstcall) THEN 
+        IF(ngrid.NE.ngridmx) THEN
+           PRINT*
+           PRINT*,'STOP dans convadj'
+           PRINT*,'ngrid    =',ngrid
+           PRINT*,'ngridmx  =',ngridmx
+        ENDIF
+        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
+             end if
+           enddo
+        endif
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+c
+c-----------------------------------------------------------------------
+c   detection des profils a modifier:
+c   ---------------------------------
+c   si le profil est a modifier
+c   (i.e. ph(niv_sup) < ph(niv_inf) )
+c   alors le tableau "vtest" est mis a .TRUE. ;
+c   sinon, il reste a sa valeur initiale (.FALSE.)
+c   cette operation est vectorisable
+c   On en profite pour copier la valeur initiale de "ph"
+c   dans le champ de travail "zh"
+
+
+      DO l=1,nlay
+         DO ig=1,ngrid
+            zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
+            zu(ig,l)=pu(ig,l)+pdufi(ig,l)*ptimestep
+            zv(ig,l)=pv(ig,l)+pdvfi(ig,l)*ptimestep
+         ENDDO
+      ENDDO
+
+      if(tracer) then      
+        DO iq =1, nq
+         DO l=1,nlay
+           DO ig=1,ngrid
+              zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+
+      CALL scopy(ngrid*nlay,zh,1,zh2,1)
+      CALL scopy(ngrid*nlay,zu,1,zu2,1)
+      CALL scopy(ngrid*nlay,zv,1,zv2,1)
+      CALL scopy(ngrid*nlay*nq,zq,1,zq2,1)
+
+      DO ig=1,ngrid
+        vtest(ig)=.FALSE.
+      ENDDO
+c
+      if (ico2.ne.0) then
+c        Special case if one of the tracer is CO2 gas
+         DO l=1,nlay
+           DO ig=1,ngrid
+             zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+           ENDDO
+         ENDDO
+       else
+          CALL scopy(ngrid*nlay,zh2,1,zhc,1)
+       end if
+
+       
+
+      DO l=2,nlay
+        DO ig=1,ngrid
+          IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.TRUE.
+        ENDDO
+      ENDDO
+c
+      jcnt=0
+      DO ig=1,ngrid
+         IF(vtest(ig)) THEN
+            jcnt=jcnt+1
+            jadrs(jcnt)=ig
+         ENDIF
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c  Ajustement des "jcnt" profils instables indices par "jadrs":
+c  ------------------------------------------------------------
+c
+      DO jj = 1, jcnt   ! loop on every convective grid point
+c
+          i = jadrs(jj)
+ 
+c   Calcul des niveaux sigma sur cette colonne
+          DO l=1,nlay+1
+            sig(l)=pplev(i,l)/pplev(i,1)
+        
+          ENDDO
+         DO l=1,nlay
+            dsig(l)=sig(l)-sig(l+1)
+            sdsig(l)=ppopsk(i,l)*dsig(l)
+         ENDDO
+          l2 = 1
+c
+c      -- boucle de sondage vers le haut
+c
+cins$     Loop  vers le haut sur l2
+          DO
+c
+            l2 = l2 + 1
+            IF (l2 .GT. nlay) EXIT
+            IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+ 
+c          -- l2 est le niveau le plus haut de la colonne instable
+ 
+              l1 = l2 - 1
+              l  = l1
+              zsm = sdsig(l2)
+              zdsm = dsig(l2)
+              zhm = zh2(i, l2)
+              if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+c
+c          -- boucle de sondage vers le bas
+c             Loop
+              DO
+c
+                zsm = zsm + sdsig(l)
+                zdsm = zdsm + dsig(l)
+                zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+                if(ico2.ne.0) then
+                  zqco2m = 
+     &            zqco2m + dsig(l) * (zq2(i,l,ico2) - zqco2m) / zdsm
+                  zhmc = zhm*(A*zqco2m+B)
+                else 
+                  zhmc = zhm
+                end if
+ 
+c            -- doit on etendre la colonne vers le bas ?
+ 
+                down = .FALSE.
+                IF (l1 .NE. 1) THEN    !--  and then
+                  IF (zhmc .LT. zhc(i, l1-1)) THEN
+                    down = .TRUE.
+                  END IF
+                END IF
+ 
+                IF (down) THEN
+ 
+                  l1 = l1 - 1
+                  l  = l1
+ 
+                ELSE
+ 
+c              -- peut on etendre la colonne vers le haut ?
+ 
+                  IF (l2 .EQ. nlay) EXIT
+ 
+                  IF (zhc(i, l2+1) .GE. zhmc) EXIT
+c
+                  l2 = l2 + 1
+                  l  = l2
+c
+                END IF
+c
+cins$         End Loop
+              ENDDO
+c
+c          -- nouveau profil : constant (valeur moyenne)
+c
+              zalpha=0.
+              zum=0.
+              zvm=0.
+              do iq=1,nq
+                zqm(iq) = 0.
+              end do
+              DO l = l1, l2
+                if(ico2.ne.0) then
+                  zalpha=zalpha+
+     &            ABS(zhc(i,l)/(A+B*zqco2m) -zhm)*dsig(l)
+                else
+                  zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                endif
+                zh2(i, l) = zhm
+                zum=zum+dsig(l)*zu(i,l)
+                zvm=zvm+dsig(l)*zv(i,l)
+                do iq=1,nq
+                   zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+                end do
+              ENDDO
+              zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+              zum=zum/(sig(l1)-sig(l2+1))
+              zvm=zvm/(sig(l1)-sig(l2+1))
+              do iq=1,nq
+                 zqm(iq) = zqm(iq)/(sig(l1)-sig(l2+1))
+              end do
+
+              IF(zalpha.GT.1.) THEN
+                 zalpha=1.
+              ELSE
+c                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-4) zalpha=1.e-4
+              ENDIF
+
+              DO l=l1,l2
+                 zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                 zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                 do iq=1,nq
+c                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+                   zq2(i,l,iq)=zqm(iq)
+                 end do
+              ENDDO
+c              diag_alpha(i)=zalpha  !temporaire
+              if (ico2.ne.0) then
+                DO l=l1, l2
+                  zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+                ENDDO
+              end if
+
+ 
+              l2 = l2 + 1
+c
+            END IF   ! fin traitement instabilité entre l1 et l2. 
+c                      On repart pour test à partir du l2 au dessus...
+          ENDDO   ! End Loop sur l2 vers le haut 
+c
+      ENDDO
+c
+      DO l=1,nlay
+        DO ig=1,ngrid
+          pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+          pduadj(ig,l)=(zu2(ig,l)-zu(ig,l))/ptimestep
+          pdvadj(ig,l)=(zv2(ig,l)-zv(ig,l))/ptimestep
+        ENDDO
+      ENDDO
+
+      if(tracer) then 
+        do iq=1, nq
+          do  l=1,nlay
+            do ig=1, ngrid
+              pdqadj(ig,l,iq)=(zq2(ig,l,iq)-zq(ig,l,iq))/ptimestep 
+            end do 
+          end do 
+        end do 
+      end if
+
+c     outpu
+      if (ngrid.eq.1) then
+         ig=1
+         iq =1 
+         write(*,*)'**** l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+         do l=nlay,1,-1
+           write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+         end do
+      end if
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgp.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgp.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgp.F	(revision 46)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/cvmgt.F	(revision 46)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datafile.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datafile.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datafile.h	(revision 46)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+! INCLUDE datafile.h
+
+!  Address of the directory containing tables of data needed by the GCM    
+
+      character (len=100) :: datafile
+      data datafile /'/u/forget/WWW/datagcm/datafile'/
+!     data datafile /'/home/forget/datafile'/
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datareadnc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datareadnc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/datareadnc.F	(revision 46)
@@ -0,0 +1,291 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,phisinit,alb,ith,
+     .                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+#include "datafile.h"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+      CHARACTER relief*3
+
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      REAL        alb(iimp1*jjp1)
+      REAL        ith(iimp1*jjp1)
+      REAL        phisinit(iimp1*jjp1)
+
+      REAL        zmea(imdp1*jmdp1)
+      REAL        zstd(imdp1*jmdp1)
+      REAL        zsig(imdp1*jmdp1)
+      REAL        zgam(imdp1*jmdp1)
+      REAL        zthe(imdp1*jmdp1)
+
+      INTEGER   lnblnk, ierr
+      EXTERNAL    lnblnk
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmxgdat
+      PARAMETER (klatdat=180,ngridmxgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(4)
+
+      CHARACTER*80    file
+
+#include "lmdstd.h"
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      write(*,*) 'ouverture du fichier surface.nc'
+
+      ierr = NF_OPEN (datafile(1:lnblnk(datafile))//'/surface.nc',
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file surface.nc '
+        write(*,*)'(in phymars/datareadnc.F)'
+        write(*,*)'It should be in :',datafile(1:lnblnk(datafile)),'/'
+        write(*,*)'1) You can change this directory address in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary surface.nc (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        CALL ABORT
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' La topographie est celle de MOLA'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=1,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          call multscal(imd*jmdp1,zdata,1000.,zdata)
+          call multscal(imd,longitude,pi/180.,longitude)
+          call multscal(jmdp1,latitude,pi/180.,latitude)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          CALL dump2d(iip1,jjp1,zmea,'zmea')
+          CALL dump2d(iip1,jjp1,zstd,'zstd')
+          CALL dump2d(iip1,jjp1,zsig,'zsig')
+          CALL dump2d(iip1,jjp1,zgam,'zgam')
+          CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      DO i=1,iimp1*jjp1
+            phisinit(i)=1000.*phisinit(i)
+      ENDDO
+      CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
+      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/def_var.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/def_var.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/def_var.F90	(revision 46)
@@ -0,0 +1,61 @@
+subroutine def_var(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+
+! This subroutine defines variable 'name' in a (pre-existing and opened)
+! NetCDF file (known from its NetCDF ID 'nid').
+! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+! corresponding dimensions must be set (in array 'dimids').
+! Upon successfull definition of the variable, 'nvarid' contains the
+! NetCDF ID of the variable.
+! The variables' attributes 'title' (Note that 'long_name' would be more
+! appropriate) and 'units' are also set. 
+
+implicit none
+
+#include "netcdf.inc"
+
+integer,intent(in) :: nid ! NetCDF file ID
+character(len=*),intent(in) :: name ! the variable's name
+character(len=*),intent(in) :: title ! 'title' attribute of variable
+character(len=*),intent(in) :: units ! 'units' attribute of variable
+integer,intent(in) :: nbdim ! number of dimensions of the variable
+integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+                                              ! the variable is defined along
+integer,intent(out) :: nvarid ! NetCDF ID of the variable
+integer,intent(out) :: ierr ! returned NetCDF staus code
+
+! 1. Switch to NetCDF define mode 
+ierr=NF_REDEF(nid)
+
+! 2. Define the variable
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed defining variable "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 3. Write attributes
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+                     len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed writing title attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+                     len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var: Failed writing units attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 4. Switch out of NetCDF define mode
+ierr = NF_ENDDEF(nid)
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimphys.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimphys.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimphys.h	(revision 46)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+! ngridmx : number of horizontal grid points
+! note: the -1/jjm term will be 0; unless jj=1
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
+! nlayermx : number of atmospheric layers
+      integer, parameter :: nlayermx = llm 
+! nsoilmx : number of subterranean layers
+!EM: old soil routine:      integer, parameter :: nsoilmx = 10
+      integer, parameter :: nsoilmx = 18 
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars.h	(revision 46)
@@ -0,0 +1,86 @@
+! ----------------------------------------------------------------------
+! -----------------------------------------------------------------------
+!   INCLUDE 'dimradmars.h'
+
+!   Declaration and initialisation or radiative transfer calculations
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+
+! nflev: number of vertical layer
+! ndlon,ndlo2: number of horizontal points
+! Splitting of horizontal grid
+! NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+! ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
+
+      INTEGER  NFLEV,NDLON,NDLO2,ndomainsz
+
+!     parameter (ndomainsz=ngridmx)
+      parameter (ndomainsz=(ngridmx-1)/20 + 1)
+!     parameter (ndomainsz=(ngridmx-1)/5 + 1) 
+
+      parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
+      parameter (NDLO2=NDLON)
+
+! Number of kind of tracer radiative properties 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! (ex: naerkind=1 if you use one dust mode without ice ...)
+! (ex: naerkind=2 if you use one dust mode and active ice ...)
+      integer naerkind
+      parameter (naerkind=1)
+
+! Reference wavelengths used to compute reference optical depth (m)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REAL longrefir(naerkind),longrefvis(naerkind)
+
+      REAL long1vis,long2vis,long3vis, long1ir,long2ir
+      REAL long1co2,long2co2
+      REAL sunfr(2)
+      integer nir, nuco2
+      INTEGER npademx,nabsmx,nt_pademx, NSUN
+
+
+! Definition of spectral intervals at thermal infrared wavelengths (LW)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      parameter (nir=4) ! Total number of thermal IR bands
+      parameter (nuco2=2) ! number of bands in CO2 bands
+      PARAMETER (long1ir=5.E-6 , long2ir=200.E-6)
+      PARAMETER (long1co2=1.E+0 / 865.E+2 , long2co2=1.E+0 / 500.E+2)
+
+!  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+!      iir=1 : central 15um CO2 bands \    
+!      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+!      iir=3 : 9 um band [long1ir - long1co2]
+!      iir=4 : Far IR    [long2co2 - long2ir]
+    
+!  Definition of spectral interval at solar wavelengths (SW)
+!  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      PARAMETER (NSUN=2)   ! do not change that !
+!  Boundaries of spectral intervals (m) : 
+      PARAMETER (long1vis=0.1E-6 , long2vis=0.5E-6 , long3vis=5.E-6)
+!  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+      DATA sunfr(1) / 0.274490 /  
+!  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+      DATA sunfr(2) / 0.725509 /
+
+! Maximum number of grain size classes
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! This parameter has to be set to the maximum number of particle
+!   sizes contained in the optical parameter database; For example,
+!   if only one grain size is used to describe dust, and 30 are used
+!   to describe water-ice crystals in the visible and 15 in the IR,
+!   nsizemax has to be set to 30.
+! If only one grain size is considered for all the aerosols, set
+!   this parameter to 1 and convolution will be turned off during
+!   the radiative calculations.
+
+!     INTEGER, PARAMETER :: nsizemax = 60
+      INTEGER, PARAMETER :: nsizemax = 1
+
+! Various initialisation for LW radiative code
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! npademx : nombre de coef de pade 
+! nabsmx : ?
+! nt_pademx : nombre d'intervalles de temperature pour pade
+
+      PARAMETER (npademx=4,nabsmx=2,nt_pademx=19)
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dimradmars_SP36.old	(revision 46)
@@ -0,0 +1,79 @@
+! ----------------------------------------------------------------------
+! -----------------------------------------------------------------------
+!   INCLUDE 'dimradmars.h'
+
+!   Declaration and initialisation or radiative transfer calculations
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+
+! nflev: number of vertical layer
+! ndlon,ndlo2: number of horizontal points
+
+      INTEGER  NFLEV,NDLON,NDLO2
+
+      parameter (NFLEV=nlayermx,NDLON=ngridmx)
+      parameter (NDLO2=NDLON)
+
+! Number of kind of tracer radiative properties 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! (ex: naerkind=1 if you use one dust mode without ice ...)
+! (ex: naerkind=2 if you use one dust mode and active ice ...)
+      integer naerkind
+      parameter (naerkind=1)
+
+! Reference wavelengths used to compute reference optical depth (m)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REAL longrefir(naerkind),longrefvis(naerkind)
+
+      REAL long1vis,long2vis,long3vis, long1ir,long2ir
+      REAL long1co2,long2co2
+      REAL sunfr(2)
+      integer nir, nuco2
+      INTEGER npademx,nabsmx,nt_pademx, NSUN
+
+
+! Definition of spectral intervals at thermal infrared wavelengths (LW)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      parameter (nir=4) ! Total number of thermal IR bands
+      parameter (nuco2=2) ! number of bands in CO2 bands
+      PARAMETER (long1ir=5.E-6 , long2ir=200.E-6)
+      PARAMETER (long1co2=1.E+0 / 865.E+2 , long2co2=1.E+0 / 500.E+2)
+
+!  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+!      iir=1 : central 15um CO2 bands \    
+!      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+!      iir=3 : 9 um band [long1ir - long1co2]
+!      iir=4 : Far IR    [long2co2 - long2ir]
+    
+!  Definition of spectral interval at solar wavelengths (SW)
+!  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      PARAMETER (NSUN=2)   ! do not change that !
+!  Boundaries of spectral intervals (m) : 
+      PARAMETER (long1vis=0.1E-6 , long2vis=0.5E-6 , long3vis=5.E-6)
+!  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+      DATA sunfr(1) / 0.274490 /  
+!  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+      DATA sunfr(2) / 0.725509 /
+
+! Maximum number of grain size classes
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! This parameter has to be set to the maximum number of particle
+!   sizes contained in the optical parameter database; For example,
+!   if only one grain size is used to describe dust, and 30 are used
+!   to describe water-ice crystals in the visible and 15 in the IR,
+!   nsizemax has to be set to 30.
+! If only one grain size is considered for all the aerosols, set
+!   this parameter to 1 and convolution will be turned off during
+!   the radiative calculations.
+
+!     INTEGER, PARAMETER :: nsizemax = 60
+      INTEGER, PARAMETER :: nsizemax = 1
+
+! Various initialisation for LW radiative code
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! npademx : nombre de coef de pade 
+! nabsmx : ?
+! nt_pademx : nombre d'intervalles de temperature pour pade
+
+      PARAMETER (npademx=4,nabsmx=2,nt_pademx=19)
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/drag_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/drag_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/drag_noro.F	(revision 46)
@@ -0,0 +1,166 @@
+      SUBROUTINE drag_noro (klon,klev,dtime,pplay,pplev,
+     e                   pvar, psig, pgam, pthe,
+     e                   kgwd,kgwdim,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+C**** *DRAG_NORO* INTERFACE FOR SUB-GRID SCALE OROGRAPHIC SCHEME
+C
+C     PURPOSE.
+C     --------
+C           ZEROS TENDENCIES, COMPUTES GEOPOTENTIAL HEIGHT AND UPDATES THE
+C           TENDENCIES AFTER THE SCHEME HAS BEEN CALLED.
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     DTIME              : LENGTH OF TIME STEP
+C     PPLAY(NLON,NLEV+1) : PRESSURE AT MIDDLE LEVELS
+C     PPLEV(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PVAR(NLON)         : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAM(NLON)         : SUB-GRID SCALE ANISOTROPY
+C     PTHE(NLON)         : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     T(NLON,NLEV)       : TEMPERATURE
+C     U(NLON,NLEV)       : ZONAL WIND
+C     V(NLON,NLEV)       : MERIDIONAL WIND
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PUSTR(NLON)        : LOW LEVEL ZONAL STRESS
+C     PVSTR(NLON)        : LOW LEVEL MERIDIONAL STRESS
+C     D_T(NLON,NLEV)     : TEMPERATURE TENDENCY
+C     D_U(NLON,NLEV)     : ZONAL WIND TENDENCY
+C     D_V(NLON,NLEV)     : MERIDIONAL WIND TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C
+c
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li F.Lott (LMD/CNRS) date: 19950201
+c Objet: Frottement de la montagne Interface
+c======================================================================
+c Arguments:
+c dtime---input-R- pas d'integration (s)
+c s-------input-R-la valeur "s" pour chaque couche
+c pplay--input-R- pression au milieu des couches en Pa
+c pplev--input-R-pression au bords des couches en Pa
+c t-------input-R-temperature (K)
+c u-------input-R-vitesse horizontale (m/s)
+c v-------input-R-vitesse horizontale (m/s)
+c
+c d_t-----output-R-increment de la temperature t
+c d_u-----output-R-increment de la vitesse u
+c d_v-----output-R-increment de la vitesse v
+c======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+c
+c ARGUMENTS
+c
+      REAL dtime
+      INTEGER klon,klev
+      real pplay(NDLO2,klev),pplev(NDLO2,klev+1)
+      REAL pvar(NDLO2),psig(NDLO2),pgam(NDLO2),pthe(NDLO2)
+      REAL pulow(NDLO2),pvlow(NDLO2),pustr(NDLO2),pvstr(NDLO2)
+      REAL u(NDLO2,klev), v(NDLO2,klev),t(NDLO2,klev)
+      REAL d_t(NDLO2,klev), d_u(NDLO2,klev), d_v(NDLO2,klev)
+c
+      INTEGER i, k, kgwd, kgwdim, kdx(NDLO2), ktest(NDLO2)
+c
+c Variables locales:
+c
+      REAL paprs(NDLO2,nlayermx+1)
+      REAL paprsf(NDLO2,nlayermx)
+      REAL zgeom(NDLO2,nlayermx)
+      REAL pdtdt(NDLO2,nlayermx)
+      REAL pdudt(NDLO2,nlayermx), pdvdt(NDLO2,nlayermx)
+      REAL pt(NDLO2,nlayermx), pu(NDLO2,nlayermx)
+      REAL pv(NDLO2,nlayermx)
+c
+c initialiser les variables de sortie (pour securite)
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c preparer les variables d'entree (attention: l'ordre des niveaux 
+c verticaux augmente du haut vers le bas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1)
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         paprsf(i,k) = pplay(i,klev-k+1)
+         paprs(i,k) = pplev(i,klev+1-k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         paprs(i,klev+1) = pplev(i,1)
+      ENDDO
+      DO i = 1, klon
+         zgeom(i,klev) = r * pt(i,klev)
+     .                  * LOG(paprs(i,klev+1)/paprsf(i,klev))
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = zgeom(i,k+1) + r * (pt(i,k)+pt(i,k+1))/2.0
+     .               * LOG(paprsf(i,k+1)/paprsf(i,k))
+      ENDDO
+      ENDDO
+c
+c appeler la routine principale
+c
+
+      CALL ORODRAG(klon,klev,kgwd,kgwdim,kdx,ktest,
+     .            dtime,
+     .            paprs, paprsf, zgeom,
+     .            pt, pu, pv, pvar, psig, pgam, pthe,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +g*pdudt(i,k)*(paprs(i,k+1)-paprs(i,k))
+         pvstr(i)        = pvstr(i)
+     .                    +g*pdvdt(i,k)*(paprs(i,k+1)-paprs(i,k))
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustdevil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustdevil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustdevil.F	(revision 46)
@@ -0,0 +1,250 @@
+      SUBROUTINE dustdevil(ngrid,nlay,nq, pplev,pu,pv,pt, ptsurf,pq2,
+     &                pdqdev,pdqs_dev)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c
+c  VERSION SPECIAL TRACEURS :
+c  Parameterization of dust devil activities
+c  to estimate dust lifting
+c  The dust devil activity is estimated based on 
+c  Renno et al. 1998 (JAS 55, 3244-3252)  
+c
+c  It is proportional to (1-b)*Fs
+c
+c  With b= [ps**(rcp+1) - ptop**(rcp+1)] / [(ps-ptop)*(rcp+1)* ps**rcp]
+c  with ptop pressure of the top of the boundary layer
+c       rcp = R/cp
+c
+c  and Fs the surface sensible heat flux = Cd*|U|*(T(1) -Tsurf)
+c       
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"      
+c#include "comconst.h"        ! TEMPORAIRE AVEC ANLDEVIL !!!!
+#include "planete.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pplev(ngrid,nlay+1)
+      REAL pt(ngrid,nlay)
+      REAL pu(ngrid,nlay)
+      REAL pv(ngrid,nlay)
+      REAL pq2(ngrid,nlay+1)
+      REAL ptsurf(ngrid)
+
+c    Traceurs :
+      integer nq 
+      real pdqdev(ngrid,nlay,nq) 
+      real pdqs_dev(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ig,l,iq
+      real Cd, z1
+      save Cd
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+
+      REAL devila(ngridmx)
+      integer ltop(ngridmx)
+      real b,rho,Fs,wind
+
+
+
+      REAL  q2top , seuil
+      SAVE  q2top , seuil
+      DATA q2top/.5/ ! value of q2 at the top of PBL
+      DATA seuil/.3/ ! value of minimum dust devil activity for dust lifting
+
+
+      DATA firstcall/.true./
+
+c   TEMPORAIRE AVEC ANLDEVIL : *************
+c        real b_diag(ngridmx)
+c       real localtime(ngridmx)
+c       common/temporaire/localtime
+c      real ztop(ngridmx),magwind(ngridmx),t1(ngridmx)
+c      real rcp ,cpp
+c      rcp = kappa
+c      cpp = r/rcp
+c   **********************************
+       
+
+c-----------------------------------------------------------------------
+c    initialisation
+c    --------------
+
+      IF (firstcall) THEN
+
+        write(*,*) 'In dustdevil :'
+        write(*,*) '    q2top= ',q2top,'     seuil= ', seuil 
+c       un petit test de coherence:
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans coefdifv'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+
+c A rough estimation of the horizontal drag coefficient Cd
+c (the scale heigh is taken to be 13 km since we are typically
+c dealing with daytime temperature around 250K.
+c 
+         z1= -0.5*13.e3*log(pplev(1,2)/pplev(1,1))
+         Cd = (0.4/log(z1/z0))**2
+
+         firstcall=.false.
+
+c        Temporaire
+c        open(77,file='devil')
+      
+      ENDIF
+
+c-----------------------------------------------------------------------
+c Initialisation
+      do iq=1,nq
+       do l=1,nlay
+           do ig=1,ngrid
+             pdqdev(ig,l,iq)= 0
+           end do
+       end do
+      end do
+
+
+c-----------------------------------------------------------------------
+c      Determining the top of the boundary layer
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+         do  l=2,nlay-1
+            if (pq2(ig,l).lt.q2top)then
+              ltop(ig)=l
+              goto 99
+            end if
+         enddo
+ 99      continue
+
+c        ***************************************
+cc        if (ptsurf(ig).gt.255)then
+c         write(*,*) 'tsurf, ztop (km): ', ig,
+c     &   ptsurf(ig), -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c         if ((ptsurf(ig).gt.50.).and.(
+c     &      (-12.*log(pplev(ig,ltop(ig))/pplev(ig,1))).gt.60.))then
+c            do l=1,nlay
+c             write(*,*) l,
+c     &       -12.*log(pplev(ig,l)/pplev(ig,1)),pq2(ig,l)
+c            end do
+c         end if
+cc        end if
+c        ***************************************
+     
+      enddo
+
+c        ***************************************
+c        do ig=100,148
+c           write(*,*)'time,tsurf,ztop', localtime(ig),ptsurf(ig),
+c    &      -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c        end do
+c        ***************************************
+
+
+c   Calculation : dust devil intensity
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do ig=1,ngrid
+
+c --------------------------------------------------
+c 1) Version 1 : sensible heat flux using actual wind :
+c        Wind magnitude:
+c        wind = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c
+c --------------------------------------------------
+c 2) Version 2 : sensible heat flux using  wind = 15 m/s
+         wind = 15.
+c ----------------------------------------------------
+c        Density :
+         rho=pplev(ig,1)/(R*pt(ig,1))
+
+c        Sensible heat flux (W.m-2) (>0 if up)
+         Fs= rho*cpp*Cd * wind
+     &       * (ptsurf(ig) -pt(ig,1))
+         b= (pplev(ig,1)**(rcp+1) - pplev(ig,ltop(ig))**(rcp+1)) /
+     &    ( (pplev(ig,1)-pplev(ig,ltop(ig)))*(rcp+1)*pplev(ig,1)**rcp)
+
+c        b_diag(ig) = b     ! TEMPORAIRE (pour diagnostique)
+
+c   Energy flux available to drive dust devil (W.m-2) : (1-b)*Fs
+c   Dust devil activity : 
+         devila(ig)= max( 0. , (1-b)*Fs - seuil ) 
+      enddo
+c   
+c     lifted dust (kg m-2 s-1)  (<0 when lifting)
+c     ~~~~~~~~~~  
+      do iq=1,nq
+         do ig=1,ngrid
+           pdqs_dev(ig,iq)= - alpha_devil(iq) * devila(ig)
+         end do
+      end do 
+
+c     Injection of dust in the atmosphere (up to the top of pbl)
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      do iq=1,nq
+       do ig=1,ngrid
+         if (devila(ig).ne.0.) then
+           do l=1,ltop(ig)
+             pdqdev(ig,l,iq)=-pdqs_dev(ig,iq)*g/
+     &        (pplev(ig,1)-pplev(ig,ltop(ig)))
+           end do
+         end if
+       end do
+      end do
+
+c *********************************************************     
+c     TEMPORAIRE AVEC ANLDEVIL:
+c     IF (ngrid.gt.1) THEN
+c      do ig=2,ngridmx-1
+c       write(77,88) lati(ig)*180./pi,localtime(ig),
+c    &        -12.*log(pplev(ig,ltop(ig))/pplev(ig,1)),
+c    &   devil(ig),min(sqrt(pu(ig,1)**2+pv(ig,1)**2),40.),
+c    &   ptsurf(ig)-pt(ig,1),ptsurf(ig),pplev(ig,1)
+c      end do    
+c88    format (f7.3,1x,f7.3,1x,f6.3,1x,f6.4,1x,f7.4,1x,
+c    &        f7.3,1x,f7.3,1x,f9.3)
+c      do ig=1,ngridmx
+c       ztop(ig) = -12.*log(pplev(ig,ltop(ig))/pplev(ig,1))
+c       magwind(ig) = sqrt(pu(ig,1)**2+pv(ig,1)**2)
+c       t1(ig) =max(ptsurf(ig)- pt(ig,1),0.)
+c      end do
+
+c       call WRITEDIAGFI(ngridmx,'dqs_dev','dqs devil',
+c    &               'kg.m-2.s-1',2,pdqs_dev)
+c       call WRITEDIAGFI(ngridmx,'wind','wind',
+c    &               'm.s-1',2,magwind)
+c       call WRITEDIAGFI(ngridmx,'ztop','top pbl',
+c    &               'km',2,ztop)
+c       call WRITEDIAGFI(ngridmx,'tsurf','tsurf',
+c    &               'K',2,ptsurf)
+c       call WRITEDIAGFI(ngridmx,'T1','T(1)',
+c    &               'K',2,t1)
+c       call WRITEDIAGFI(ngridmx,'b','b',
+c    &               ' ',2,b_diag)
+c     END If
+c *********************************************************     
+         
+      RETURN
+      END
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustlift.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustlift.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/dustlift.F	(revision 46)
@@ -0,0 +1,110 @@
+      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
+      DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+
+
+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: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.F	(revision 46)
@@ -0,0 +1,59 @@
+      subroutine eofdump(ngrid,nlayer,u,v,t,rho,ps)
+
+      implicit none
+c
+c     Dumps profiles for calculation of variability EOFs 
+c     Modified to include rho, FF 09/2004
+c     Corrected small bug in sampling rate/count, EM 11/2007
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "eofdump.h"
+c
+
+      integer ngrid
+      integer nlayer
+      real*4 u(ngrid,nlayer)
+      real*4 v(ngrid,nlayer)
+      real*4 t(ngrid,nlayer)
+      real*4 rho(ngrid,nlayer)
+      real*4 ps(ngrid)
+      integer count
+      data count /0/
+      save count
+      integer i,j,l, ig
+
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+c-------------------------------------------------------
+c     Initialization at first call:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (firstcall) THEN
+        write(*,*) 'CALL ineofdump'
+        CALL ineofdump
+        firstcall=.false.
+      END IF
+
+c-------------------------------------------------------
+c     Dumps every ieofs physics timesteps
+c
+!      write(*,*)'eofdump:count=',count,' ps(1)=',ps(1)
+!      if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then
+      if (mod(count+1,ieofs).eq.0) then
+!        write(*,*)'eofdump: dump --> ps(1)=',ps(1)
+        do i=1,iim,eofskip
+          do j=1+eofskip/2,jjm+1,eofskip
+            ig = 1+ (j-2)*iim +i
+            write(uedata) (u(ig,l),l=1,nlayer)
+            write(uedata) (v(ig,l),l=1,nlayer)
+            write(uedata) (t(ig,l),l=1,nlayer)
+            write(uedata) (rho(ig,l),l=1,nlayer)
+            write(uedata) ps(ig)
+          enddo
+        enddo
+      endif
+      count=count+1
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/eofdump.h	(revision 46)
@@ -0,0 +1,22 @@
+c
+c  eofdump:
+c	This include file controls the production of data for EOFs.
+c
+c	Dump profiles for EOFs every ieofs physics timesteps,
+c       starting at first call.
+	integer ieofs
+c
+c	Only dump profiles every eofskip points in each direction
+c       on the model grid.
+	integer eofskip
+	parameter (eofskip = 4)
+c
+c	Units for writing EOF header and data
+	integer uehead, uedata
+	parameter (uehead = 82, uedata = 83)
+c
+	common /eofcom/ ieofs
+c
+      INTEGER npgrid
+      PARAMETER(npgrid=ngridmx+2*(iim-1))
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/flusv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/flusv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/flusv.F	(revision 46)
@@ -0,0 +1,333 @@
+      SUBROUTINE flusv(KDLON,nsf,n,omega,g,tau,emis,bh,bsol,fah,fdh)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  calcul des flux ascendant et descendant aux interfaces entre n couches
+c  * dans l'infrarouge 
+c  * B est une fonction lineaire de $\tau$ a l'interieur de chaque couche
+c  * le B du sol peut etre different de celui qui correspond au profil
+c    de la n-ieme couche
+c  * l'hypothese est une hypothese a deux flux isotropes sur chaque 
+c    hemisphere ("hemispheric constant") + "source function technique"
+c    (voir Toon et al. 1988)
+c  * le flux descendant en haut de l'atmosphere est nul
+c  * les couches sont numerotees du haut de l'atmosphere vers le sol
+c
+c  in :   * KDLON      ---> dimension de vectorisation
+c         * nsf        ---> nsf=0 ==> "hemispheric constant"
+c                           nsf>0 ==> "hemispheric constant" + "source function"
+c         * n          ---> nombre de couches
+c         * omega(i)   ---> single scattering albedo pour la i-eme couche
+c         * g(i)       ---> asymmetry parameter pour la i-eme couche
+c         * tau(i)     ---> epaisseur optique de la i-eme couche
+c         * emis       ---> emissivite du sol
+c         * bh(i)      ---> luminance du corps noir en haut de la i-eme
+c                           couche, bh(n+1) pour la valeur au sol qui
+c                           correspond au profil de la n-ieme couche
+c         * bsol       ---> luminance du corps noir au sol
+c
+c  out :  * fah(i)     ---> flux ascendant en haut de la i-eme couche,
+c                           fah(n+1) pour le sol 
+c         * fdh(i)     ---> flux descendant en haut de la i-eme couche,
+c                           fdh(n+1) pour le sol 
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,nsf,n
+      REAL omega(NDLO2,n),g(NDLO2,n),tau(NDLO2,n),emis(NDLO2)
+     &,bh(NDLO2,n+1),bsol(NDLO2),fah(NDLO2,n+1),fdh(NDLO2,n+1)
+c.......................................................................
+c  declaration des variables locales
+c 
+      REAL pi
+      PARAMETER (pi=3.141592653589793E+0)
+      INTEGER iv,i,j
+      REAL beta,gama1,gama2,amu1,grgama,b0,b1
+      REAL a(NDLON,4*nlayermx),b(NDLON,4*nlayermx)
+     &    ,d(NDLON,4*nlayermx),e(NDLON,4*nlayermx)
+     &    ,y(NDLON,4*nlayermx)
+     &    ,alambda(NDLON,2*nlayermx)
+     &    ,e1(NDLON,2*nlayermx),e2(NDLON,2*nlayermx)
+     &    ,e3(NDLON,2*nlayermx),e4(NDLON,2*nlayermx)
+     &    ,cah(NDLON,2*nlayermx),cab(NDLON,2*nlayermx)
+     &    ,cdh(NDLON,2*nlayermx),cdb(NDLON,2*nlayermx)
+      REAL grg(NDLON,2*nlayermx),grh(NDLON,2*nlayermx)
+     &    ,grj(NDLON,2*nlayermx),grk(NDLON,2*nlayermx)
+     &    ,alpha1(NDLON,2*nlayermx),alpha2(NDLON,2*nlayermx)
+     &    ,sigma1(NDLON,2*nlayermx),sigma2(NDLON,2*nlayermx)
+      INTEGER nq
+      PARAMETER (nq=8)
+      REAL x(nq),w(nq),gri(NDLON,nq)
+      DATA x/1.9855071751231860E-2 , 0.1016667612931866E+0
+     &     , 0.2372337950418355E+0 , 0.4082826787521751E+0
+     &     , 0.5917173212478250E+0 , 0.7627662049581645E+0
+     &     , 0.8983332387068134E+0 , 0.9801449282487682E+0/
+      DATA w/5.0614268145185310E-2 , 0.1111905172266872E+0
+     &     , 0.1568533229389437E+0 , 0.1813418916891810E+0
+     &     , 0.1813418916891810E+0 , 0.1568533229389437E+0
+     &     , 0.1111905172266872E+0 , 5.0614268145185310E-2/
+c....................................................................... 
+c
+c....................................................................... 
+      do 10001 i=1,n
+                                                   do 99999 iv=1,KDLON
+      beta=(1.E+0-g(iv,i))/2.E+0
+      gama1=2.E+0*(1.E+0-omega(iv,i)*(1.E+0-beta))
+      gama2=2.E+0*omega(iv,i)*beta
+      amu1=5.E-1
+      alambda(iv,i)=sqrt(gama1**2-gama2**2)
+      grgama=(gama1-alambda(iv,i))/gama2
+c
+c ici une petite bidouille : si l'epaisseur optique d'une couche
+c est trop faible, $dB \over d\tau$ devient tres grand et le schema
+c s'ecroule. dans ces cas, on fait l'hypothese de couche isotherme.
+c
+      if (tau(iv,i).gt.1.E-3) then
+      b0=bh(iv,i)
+      b1=(bh(iv,i+1)-b0)/tau(iv,i)
+      else
+      b0=(bh(iv,i)+bh(iv,i+1))/2.E+0
+      b1=0.E+0
+      endif
+c
+      e1(iv,i)=1.E+0+grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e2(iv,i)=1.E+0-grgama*exp(-alambda(iv,i)*tau(iv,i))
+      e3(iv,i)=grgama+exp(-alambda(iv,i)*tau(iv,i))
+      e4(iv,i)=grgama-exp(-alambda(iv,i)*tau(iv,i))
+      cah(iv,i)=2.E+0*pi*amu1*(b0+b1/(gama1+gama2))
+      cab(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)+1.E+0/(gama1+gama2)))
+      cdh(iv,i)=2.E+0*pi*amu1*(b0-b1/(gama1+gama2))
+      cdb(iv,i)=2.E+0*pi*amu1*(b0+b1*(tau(iv,i)-1.E+0/(gama1+gama2)))  
+c
+      grg(iv,i)=(1.E+0/amu1-alambda(iv,i))
+      grh(iv,i)=grgama*(alambda(iv,i)+1.E+0/amu1)
+      grj(iv,i)=grh(iv,i)
+      grk(iv,i)=grg(iv,i)
+      alpha1(iv,i)=2.E+0*pi*(b0+b1*(1.E+0/(gama1+gama2)-amu1))
+      alpha2(iv,i)=2.E+0*pi*b1
+      sigma1(iv,i)=2.E+0*pi*(b0-b1*(1.E+0/(gama1+gama2)-amu1))
+      sigma2(iv,i)=alpha2(iv,i)
+c
+99999                                              continue
+10001 continue
+c.......................................................................
+                                                   do 99998 iv=1,KDLON
+      a(iv,1)=0.E+0
+      b(iv,1)=e1(iv,1)
+      d(iv,1)=-e2(iv,1)
+      e(iv,1)=-cdh(iv,1)
+99998                                              continue
+c
+      do 10002 i=1,n-1 
+      j=2*i+1
+                                                   do 99997 iv=1,KDLON
+      a(iv,j)=e2(iv,i)*e3(iv,i)-e4(iv,i)*e1(iv,i)
+      b(iv,j)=e1(iv,i)*e1(iv,i+1)-e3(iv,i)*e3(iv,i+1)
+      d(iv,j)=e3(iv,i)*e4(iv,i+1)-e1(iv,i)*e2(iv,i+1)
+      e(iv,j)=e3(iv,i)*(cah(iv,i+1)-cab(iv,i))
+     &       +e1(iv,i)*(cdb(iv,i)-cdh(iv,i+1))
+99997                                              continue
+10002 continue
+c
+      do 10003 i=1,n-1
+      j=2*i
+                                                   do 99996 iv=1,KDLON
+      a(iv,j)=e2(iv,i+1)*e1(iv,i)-e3(iv,i)*e4(iv,i+1)
+      b(iv,j)=e2(iv,i)*e2(iv,i+1)-e4(iv,i)*e4(iv,i+1)
+      d(iv,j)=e1(iv,i+1)*e4(iv,i+1)-e2(iv,i+1)*e3(iv,i+1)
+      e(iv,j)=e2(iv,i+1)*(cah(iv,i+1)-cab(iv,i))
+     &       +e4(iv,i+1)*(cdb(iv,i)-cdh(iv,i+1))
+99996                                              continue
+10003 continue
+c     
+      j=2*n
+                                                   do 99995 iv=1,KDLON
+      a(iv,j)=e1(iv,n)-(1.E+0-emis(iv))*e3(iv,n)
+      b(iv,j)=e2(iv,n)-(1.E+0-emis(iv))*e4(iv,n)
+      d(iv,j)=0.E+0
+      e(iv,j)=emis(iv)*pi*bsol(iv)-cab(iv,n)+(1.E+0-emis(iv))*cdb(iv,n)
+99995                                              continue
+c.......................................................................
+      call sys3v(KDLON,2*n,a,b,d,e,y)
+c....................................................................... 
+      do 10004 i=1,n
+                                                   do 99994 iv=1,KDLON
+      grg(iv,i)=grg(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grh(iv,i)=grh(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+      grj(iv,i)=grj(iv,i)*(y(iv,2*i-1)+y(iv,2*i))
+      grk(iv,i)=grk(iv,i)*(y(iv,2*i-1)-y(iv,2*i))
+99994                                              continue
+10004 continue
+c.......................................................................
+c les valeurs de flux "hemispheric constant"
+c 
+      IF (nsf.eq.0) THEN
+      do 10005 i=1,n
+                                                   do 99993 iv=1,KDLON
+      fah(iv,i)=e3(iv,i)*y(iv,2*i-1)-e4(iv,i)*y(iv,2*i)+cah(iv,i)
+      fdh(iv,i)=e1(iv,i)*y(iv,2*i-1)-e2(iv,i)*y(iv,2*i)+cdh(iv,i)
+99993                                              continue
+10005 continue
+                                                   do 99992 iv=1,KDLON
+      fah(iv,n+1)=e1(iv,n)*y(iv,2*n-1)+e2(iv,n)*y(iv,2*n)+cab(iv,n)
+      fdh(iv,n+1)=e3(iv,n)*y(iv,2*n-1)+e4(iv,n)*y(iv,2*n)+cdb(iv,n)
+99992                                              continue
+      GOTO 10100
+      ENDIF 
+c....................................................................... 
+c passage a "source function" 
+c 
+c on applique une quadrature de dimension nq
+c x est le vecteur des \mu de la quadrature
+c w est le vecteur des poids correspondants
+c nq est fixe en parameter
+c x et w sont fixes en data
+c 
+c....................................................................... 
+c on part d'en haut et on descent selon les nq angles pour calculer
+c tous les flux descendants 
+c
+      do 10006 j=1,nq 
+                                                   do 99991 iv=1,KDLON
+      gri(iv,j)=0.E+0
+99991                                              continue
+10006 continue
+                                                   do 99990 iv=1,KDLON
+      fdh(iv,1)=0.E+0
+99990                                              continue
+      do 10007 i=1,n
+      do 10008 j=1,nq
+                                                   do 99989 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grj(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+grk(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+sigma1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+sigma2(iv,i)*(x(j)*exp(-tau(iv,i)/x(j))+tau(iv,i)-x(j))
+99989                                              continue
+10008 continue
+                                                   do 99988 iv=1,KDLON
+      fdh(iv,i+1)=0.E+0
+99988                                              continue
+      do 10009 j=1,nq 
+                                                   do 99987 iv=1,KDLON
+      fdh(iv,i+1)=fdh(iv,i+1)+w(j)*x(j)*gri(iv,j)
+99987                                              continue
+10009 continue
+10007 continue
+c.......................................................................
+c on applique la condition de reflexion a sol 
+c
+                                                   do 99986 iv=1,KDLON
+      fah(iv,n+1)=(1.E+0-emis(iv))*fdh(iv,n+1)+pi*emis(iv)*bsol(iv)
+99986                                              continue
+      do 10010 j=1,nq
+                                                   do 99985 iv=1,KDLON
+      gri(iv,j)=2.E+0*fah(iv,n+1)
+99985                                              continue
+10010 continue 
+c.......................................................................
+c on remonte pour calculer tous les flux ascendants 
+c  
+      do 10011 i=n,1,-1 
+      do 10012 j=1,nq 
+                                                   do 99984 iv=1,KDLON
+      gri(iv,j)=gri(iv,j)*exp(-tau(iv,i)/x(j))
+     &+grg(iv,i)/(alambda(iv,i)*x(j)-1.E+0)
+     &*(exp(-tau(iv,i)/x(j))-exp(-tau(iv,i)*alambda(iv,i)))
+     &+grh(iv,i)/(alambda(iv,i)*x(j)+1.E+0)
+     &*(1.E+0-exp(-tau(iv,i)*(alambda(iv,i)+1.E+0/x(j))))
+     &+alpha1(iv,i)*(1.E+0-exp(-tau(iv,i)/x(j)))
+     &+alpha2(iv,i)*(x(j)-(tau(iv,i)+x(j))*exp(-tau(iv,i)/x(j)))
+99984                                              continue
+10012 continue
+                                                   do 99983 iv=1,KDLON
+      fah(iv,i)=0.E+0
+99983                                              continue
+      do 10013 j=1,nq 
+                                                   do 99982 iv=1,KDLON
+      fah(iv,i)=fah(iv,i)+w(j)*x(j)*gri(iv,j)
+99982                                              continue
+10013 continue
+10011 continue
+c.......................................................................
+10100 continue      
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END
+
+c ***************************************************************
+
+
+      SUBROUTINE sys3v(KDLON,n,a,b,d,e,y)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  inversion d'un systeme lineaire tridiagonal
+c
+c  |  b1  d1               |   | y1 |   | e1 |
+c  |  a2  b2  d2           |   | y2 |   | e2 |
+c  |      a3  b3  d3       | * | y3 | = | e3 |
+c  |             ....      |   |    |   |    |
+c  |              an  bn   |   | yn |   | en |
+c
+c  in :   * KDLON        --> dimension de vectorisation
+c         * n            --> dimension du systeme
+c         * a,b,d,e      --> voir dessin
+c
+c  out :  * y            --> voir dessin
+c
+c.......................................................................
+c  include des dimensions locales
+c 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER KDLON,n
+      REAL a(NDLO2,n),b(NDLO2,n),d(NDLO2,n),e(NDLO2,n),y(NDLO2,n)
+c.......................................................................
+c  declaration des variables locales
+c 
+      INTEGER iv,i
+      REAL as(NDLON,4*nlayermx),ds(NDLON,4*nlayermx)
+     &    ,x(NDLON,4*nlayermx)
+c.......................................................................
+c
+c.......................................................................
+                                                   do 99999 iv=1,KDLON
+      as(iv,n)=a(iv,n)/b(iv,n)
+      ds(iv,n)=e(iv,n)/b(iv,n)
+99999                                              continue
+      do 10001 i=n-1,1,-1
+                                                   do 99998 iv=1,KDLON
+      x(iv,i)=1.E+0/(b(iv,i)-d(iv,i)*as(iv,i+1))
+      as(iv,i)=a(iv,i)*x(iv,i)
+      ds(iv,i)=(e(iv,i)-d(iv,i)*ds(iv,i+1))*x(iv,i)
+99998                                              continue
+10001 continue 
+                                                   do 99997 iv=1,KDLON
+      y(iv,1)=ds(iv,1)
+99997                                              continue
+      do 10002 i=2,n 
+                                                   do 99996 iv=1,KDLON
+      y(iv,i)=ds(iv,i)-as(iv,i)*y(iv,i-1)
+99996                                              continue
+10002 continue
+c.......................................................................
+c
+c.......................................................................
+      RETURN
+      END 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/growthrate.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/growthrate.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/growthrate.F	(revision 46)
@@ -0,0 +1,107 @@
+      subroutine growthrate(timestep,t,p,ph2o,psat,seq,r,Cste)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c     Determination of the water ice crystal growth rate
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c
+c   arguments:
+c   ----------
+
+      REAL timestep
+      REAL t    ! temperature in the middle of the layer (K)
+      REAL p    ! pressure in the middle of the layer (K)
+      REAL*8 ph2o ! water vapor partial pressure (Pa)
+      REAL*8 psat ! water vapor saturation pressure (Pa) 
+      REAL r    ! crystal radius before condensation (m)
+      REAL seq  ! Equilibrium saturation ratio
+      REAL dr   ! crystal radius variation (m)
+
+c   local:
+c   ------
+
+      REAL molco2,molh2o
+      REAL Mco2,Mh2o,rho_i,sigh2o
+      REAL nav,rgp,kbz,pi,To
+
+c     Effective gas molecular radius (m)
+      data molco2/2.2e-10/   ! CO2
+c     Effective gas molecular radius (m)
+      data molh2o/1.2e-10/   ! H2O
+c     Molecular weight of CO2
+      data Mco2/44.e-3/            ! kg.mol-1
+c     Molecular weight of H2O
+      data Mh2o/18.e-3/            ! kg.mol-1
+c     surface tension of ice/vapor
+      data sigh2o/0.12/	     ! N.m
+c     Ice density
+      data rho_i/917./        ! kg.m-3 also defined in initcld.f
+c     Avogadro number
+      data nav/6.023e23/
+c     Perfect gas constant
+      data rgp/8.3143/
+c     Boltzman constant
+      data kbz/1.381e-23/
+c     pi number
+      data pi/3.141592654/
+c     Reference temperature, T=273,15 K 
+      data To/273.15/
+
+      REAL k,Lv                 
+      REAL knudsen           ! Knudsen number (gas mean free path/particle radius)
+      REAL a,Dv,lambda       ! Intermediate computations for growth rate
+      REAL*8 Rk,Rd
+      REAL Cste, rf
+
+c-----------------------------------------------------------------------
+c      Ice particle growth rate by diffusion/impegement of water molecules
+c                r.dr/dt = (S-Seq) / (Seq*Rk+Rd)
+c        with r the crystal radius, Rk and Rd the resistances due to 
+c        latent heat release and to vapor diffusion respectively 
+c----------------------------------------------------------------------- 
+
+c     - Equilibrium saturation accounting for KeLvin Effect
+       seq=exp(2*sigh2o*Mh2o/(rho_i*rgp*t*r))
+
+c     - Thermal conductibility of CO2
+      k  = (0.17913 * t - 13.9789) * 4.184e-4
+c     - Latent heat of h2o (J.kg-1)
+      Lv = (2834.3 - 0.28 * (t-To) - 0.004 * (t-To)**2 ) * 1.e+3
+
+c     - Constant to compute gas mean free path
+c     l= (T/P)*a, with a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+      a = 0.707*rgp/(4 * pi* molco2**2  * nav)
+
+c     - Compute Dv, water vapor diffusion coefficient
+c       accounting for both kinetic and continuum regime of diffusion,
+c       the nature of which depending on the Knudsen number.
+
+      Dv = 1./3. * sqrt( 8*kbz*t/(pi*Mh2o/nav) )* kbz * t / 
+     &   ( pi * p * (molco2+molh2o)**2 * sqrt(1.+Mh2o/Mco2) )
+
+      knudsen = t / p * a / r
+      lambda  = (1.333+0.71/knudsen) / (1.+1./knudsen)
+      Dv      = Dv / (1. + lambda * knudsen)
+
+c     - Compute Rk
+      Rk = Lv**2 * rho_i * Mh2o / (k*rgp*t**2.)
+c     - Compute Rd
+      Rd = rgp * t *rho_i / (Dv*psat*Mh2o)
+
+c     - Compute Cste=rdr/dt, then r(t+1)= sqrt(r(t)**2.+2.*Cste*dt)
+       Cste = 1. / (seq*Rk+Rd)
+c      Cste = (ph2o/psat-seq) / (seq*Rk+Rd)
+c      rf   = sqrt( max( r**2.+2.*Cste*timestep , 0. ) )
+c      dr   = rf-r
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwprofil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwprofil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwprofil.F	(revision 46)
@@ -0,0 +1,216 @@
+      SUBROUTINE GWPROFIL
+     *         ( klon, klev
+     *         , kgwd ,kdx  , ktest
+     *         , KKCRIT, KKCRITH, KCRIT ,  kkenvh, kknu,kknu2
+     *         , PAPHM1, PRHO   , PSTAB , PTFR , PVPH , PRI , PTAU
+     *         , ptauf ,pdmod   , pnu   , psig ,pgamma, pvar      )
+
+C**** *GWPROFIL*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD:
+C     -------
+C     THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
+C     IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
+C     AND THE TOP OF THE BLOCKED LAYER (KKENVH).
+C     IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE 
+C     BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR 
+C     NONLINEAR GRAVITY WAVE BREAKING.
+C     ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
+C     LEVEL (KCRIT) OR WHEN IT BREAKS.
+C     
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kgwd
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2)
+     *       ,kdx(NDLO2),ktest(NDLO2)
+     *       ,kkenvh(NDLO2),kknu(NDLO2),kknu2(NDLO2)
+C
+      REAL PAPHM1(NDLO2,klev+1), PSTAB(NDLO2,klev+1),
+     *     PRHO  (NDLO2,klev+1), PVPH (NDLO2,klev+1),
+     *     PRI   (NDLO2,klev+1), PTFR (NDLO2), PTAU(NDLO2,klev+1),
+     *     ptauf (NDLO2,klev+1)
+     
+      REAL pdmod (NDLO2) , pnu (NDLO2) , psig(NDLO2),
+     *     pgamma(NDLO2) , pvar(NDLO2)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+c   declarations pour 'implicit none"
+      real zsqr,zalfa,zriw,zalpha,zb,zdel,zdz2n,zdelp,zdelpt
+
+      integer ji,jk,jl,ilevh
+      REAL ZDZ2 (NDLO2,nlayermx) , ZNORM(NDLO2) , zoro(NDLO2)
+      REAL ZTAU (NDLO2,nlayermx+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      ilevh=KLEV/3
+C
+      DO 400 ji=1,kgwd
+      jl=kdx(ji)
+      Zoro(JL)=Psig(JL)*Pdmod(JL)/4./max(pvar(jl),1.0)
+      ZTAU(JL,KKNU(JL)+1)=PTAU(JL,KKNU(JL)+1)
+      ZTAU(JL,KLEV+1)=PTAU(JL,KLEV+1)
+  400 CONTINUE
+C
+      DO 430 JK=KLEV,2,-1
+C
+C
+C*         4.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
+C                 BLOCKING LAYER.
+  410 CONTINUE
+C
+      DO 411 ji=1,kgwd
+      jl=kdx(ji)
+           IF(JK.GE.KKNU2(JL)) THEN
+           PTAU(JL,JK)=ZTAU(JL,KLEV+1)
+           ENDIF
+ 411  CONTINUE             
+C
+C*         4.15   CONSTANT SHEAR STRESS UNTIL THE TOP OF THE
+C                 LOW LEVEL FLOW LAYER.
+ 415  CONTINUE
+C        
+C
+C*         4.2    WAVE DISPLACEMENT AT NEXT LEVEL.
+C
+  420 CONTINUE
+C
+      DO 421 ji=1,kgwd
+      jl=kdx(ji)
+      IF(JK.LT.KKNU2(JL)) THEN
+      ZNORM(JL)=gkdrag*PRHO(JL,JK)*SQRT(PSTAB(JL,JK))*PVPH(JL,JK)
+     *                                                    *zoro(jl)
+      ZDZ2(JL,JK)=PTAU(JL,JK+1)/max(ZNORM(JL),gssec)
+      ENDIF
+  421 CONTINUE
+C
+C*         4.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
+C*                AND STRESS:  BREAKING EVALUATION AND CRITICAL 
+C                 LEVEL
+C
+      DO 431 ji=1,kgwd
+      jl=kdx(ji)
+          IF(JK.LT.KKNU2(JL)) THEN
+          IF((PTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.KCRIT(JL))) THEN
+            PTAU(JL,JK)=0.0
+          ELSE
+               ZSQR=SQRT(PRI(JL,JK))
+               ZALFA=SQRT(PSTAB(JL,JK)*ZDZ2(JL,JK))/PVPH(JL,JK)
+               ZRIW=PRI(JL,JK)*(1.-ZALFA)/(1+ZALFA*ZSQR)**2
+               IF(ZRIW.LT.GRCRIT) THEN
+                 ZDEL=4./ZSQR/GRCRIT+1./GRCRIT**2+4./GRCRIT
+                 ZB=1./GRCRIT+2./ZSQR
+                 ZALPHA=0.5*(-ZB+SQRT(ZDEL))
+                 ZDZ2N=(PVPH(JL,JK)*ZALPHA)**2/PSTAB(JL,JK)
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2N
+               ELSE
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2(JL,JK)
+               ENDIF
+            PTAU(JL,JK)=MIN(PTAU(JL,JK),PTAU(JL,JK+1))
+          ENDIF
+          ENDIF
+  431 CONTINUE
+  
+  430 CONTINUE
+  440 CONTINUE
+  
+c     write(*,*) 'ptau'
+c     write(*,99) ((ji,ilevh,ptau(ji,ilevh),ji=1,NDLO2),
+c    .                  ilevh=1,nlayermx+1)
+ 99   FORMAT(i3,i3,f15.5)
+
+
+C  REORGANISATION OF THE STRESS PROFILE
+C  IF BREAKING OCCURS AT LOW LEVEL:
+
+      DO 530 ji=1,kgwd
+      jl=kdx(ji)
+      ZTAU(JL,KKENVH(JL))=PTAU(JL,KKENVH(JL))
+      ZTAU(JL,KKCRITH(JL))=PTAU(JL,KKCRITH(JL))
+ 530  CONTINUE      
+
+      DO 531 JK=1,KLEV
+      
+      DO 532 ji=1,kgwd
+      jl=kdx(ji)
+                
+         IF(JK.GT.KKCRITH(JL).AND.JK.LT.KKENVH(JL))THEN
+
+          ZDELP=PAPHM1(JL,JK)-PAPHM1(JL,KKENVH(JL))
+          ZDELPT=PAPHM1(JL,KKCRITH(JL))-PAPHM1(JL,KKENVH(JL))
+          PTAU(JL,JK)=ZTAU(JL,KKENVH(JL)) +
+     .                (ZTAU(JL,KKCRITH(JL))-ZTAU(JL,KKENVH(JL)) )*
+     .                ZDELP/ZDELPT
+     
+        ENDIF
+            
+ 532  CONTINUE    
+ 
+ 531  CONTINUE        
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwstress.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwstress.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/gwstress.F	(revision 46)
@@ -0,0 +1,134 @@
+      SUBROUTINE GWSTRESS
+     *         (  klon  , klev
+     *         , KKCRIT, KSECT, KKHLIM, KTEST, KKCRITH, KCRIT, kkenvh
+     *         , kknu
+     *         , PRHO  , PSTAB, PVPH  , PVAR ,PVARor, psig  
+     *         , PTFR  , PTAU  
+     *         ,pgeom1 , pgamma, pd1  , pd2   ,pdmod ,pnu )
+C
+C**** *GWSTRESS*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C     CALL *GWSTRESS*  FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F. LOTT PUT THE NEW GWD ON IFS      22/11/93
+C
+C-----------------------------------------------------------------------
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),KKENVH(NDLO2),KKNU(NDLO2)
+C
+      REAL PRHO(NDLO2,klev+1),PSTAB(NDLO2,klev+1),PTAU(NDLO2,klev+1),
+     *     PVPH(NDLO2,klev+1),PVAR(NDLO2,4),PTFR(NDLO2),
+     *     pgeom1(NDLO2,klev),PVARor(NDLO2)
+C
+      real pd1(NDLO2),pd2(NDLO2),pnu(NDLO2),psig(NDLO2),pgamma(NDLO2)
+      real pdmod(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      integer jl
+      real zblock,zvar,zeff
+      logical lo
+
+C
+C-----------------------------------------------------------------------
+C
+C*       0.3   FUNCTIONS
+C              ---------
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+
+C
+ 100  CONTINUE
+C
+C*         3.1     GRAVITY WAVE STRESS.
+C
+  300 CONTINUE
+C
+C
+      DO 301 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      
+C  EFFECTIVE MOUNTAIN HEIGHT ABOVE THE BLOCKED FLOW
+  
+c        IF(KKENVH(JL).EQ.KLEV)THEN
+         ZBLOCK=0.0 
+c        ELSE
+c         ZBLOCK=(PGEOM1(JL,KKENVH(JL))+PGEOM1(JL,KKENVH(JL)+1))/2./RG          
+c        ENDIF
+      
+        ZVAR=PVAROR(JL)
+        ZEFF=AMAX1(0.,2.*ZVAR-ZBLOCK)
+
+        PTAU(JL,KLEV+1)=PRHO(JL,KLEV+1)*GKDRAG*psig(jl)*ZEFF**2
+     *    /4./ZVAR*PVPH(JL,KLEV+1)*pdmod(jl)*sqrt(pstab(jl,klev+1))
+
+C  TOO SMALL VALUE OF STRESS OR  LOW LEVEL FLOW INCLUDE CRITICAL LEVEL
+C  OR LOW LEVEL FLOW:  GRAVITY WAVE STRESS NUL.
+                
+        LO=(PTAU(JL,KLEV+1).LT.GTSEC).OR.(KCRIT(JL).GE.KKNU(JL))
+     *      .OR.(PVPH(JL,KLEV+1).LT.GVCRIT)
+c       IF(LO) PTAU(JL,KLEV+1)=0.0
+      
+      ELSE
+      
+          PTAU(JL,KLEV+1)=0.0
+          
+      ENDIF
+      
+  301 CONTINUE
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ineofdump.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ineofdump.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ineofdump.F	(revision 46)
@@ -0,0 +1,71 @@
+      subroutine ineofdump
+
+c._.  subroutine ineofdump(long, lati)
+
+      implicit none
+c
+c     Initialise dumping of profiles for EOF calculations
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comvert.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+c
+c._.#include "param2"
+c._.#include "bats"
+c._.#include "outcon"
+c._.#include "phycmn"
+c
+#include "eofdump.h"
+c
+c._.      real*4 long(cols,rows)
+c._.      real*4 lati(cols,rows)
+      integer ig,i,j,l    
+      logical firstcall
+      save firstcall
+
+      data firstcall/.true./
+
+      if (firstcall) then
+         firstcall=.false.
+      endif
+
+c
+c     Set frequency for dumping at once per day
+c
+      ieofs=nint(daysec/dtphys)
+      if (abs(float(ieofs)-daysec/dtphys).gt.1.e-8*daysec)
+     :   stop'In ineofdump:  1 day .ne. n physics timesteps'
+c
+c     Header
+c
+      open(uehead,file='profiles.hdr',form='formatted')
+c._.  write(uehead,*) rntape, kstart, ktotal, itspd, kphysic, refday
+      write(uehead,*) 0.E+0,0,0,ieofs,1,0
+c._.  write(uehead,*) cols, rows, npgrid, nl
+      write(uehead,*) iim,npgrid/iim,npgrid,nlayermx
+
+c._.  do i=1,cols,eofskip
+c._.    do j=1+eofskip/2,rows,eofskip
+c._.      write(uehead,*) long(i,j)*180./pi, lati(i,j)*180./pi
+c._.    enddo
+c._.  enddo
+      do i=1,iim,eofskip
+        do j=1+eofskip/2,jjm+1,eofskip    
+          ig = 1+ (j-2)*iim +i
+          if(j.eq.1) stop 'Problem in ineofdump.F'
+          if(j.eq.jjm+1) stop 'Problem in ineofdump.F'
+          write(uehead,*) long(ig)*180./pi, lati(ig)*180./pi
+c         write(*,*) 'eof grid j=',j,' lat= ', lati(ig)*180./pi
+        enddo
+      enddo
+
+      write(uehead,*) aps
+      write(uehead,*) bps
+      close(uehead)
+c
+c     Main profile file
+c
+      open(uedata,file='profiles.dat',form='unformatted')
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inifis.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inifis.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inifis.F	(revision 46)
@@ -0,0 +1,556 @@
+      SUBROUTINE inifis(ngrid,nlayer,
+     $           day_ini,pdaysec,ptimestep,
+     $           plat,plon,parea,
+     $           prad,pg,pr,pcpp)
+!
+!=======================================================================
+!
+!   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
+!
+!
+!   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'
+      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"
+#include "yomaer.h"
+
+      REAL prad,pg,pr,pcpp,pdaysec,ptimestep
+ 
+      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
+      integer day_ini
+      INTEGER ig,ierr
+ 
+      EXTERNAL SSUM
+      REAL SSUM
+ 
+      CHARACTER ch1*12
+      CHARACTER ch80*80
+
+
+      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: Parametres pour la physique (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+
+         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
+         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
+
+         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)
+
+      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=10*int(daysec/dtphys) 
+      ilwn=2               
+      linear=.true.        
+      ncouche=3
+      alphan=0.4
+      ilwb=2
+      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:
+!     ------------------------
+
+      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)
+
+      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
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniorbit.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniorbit.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniorbit.F	(revision 46)
@@ -0,0 +1,102 @@
+      SUBROUTINE iniorbit
+     $     (paphelie,pperiheli,pyear_day,pperi_day,pobliq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:
+c   -------
+c     Frederic Hourdin      22 Fevrier 1991
+c
+c   Objet:
+c   ------
+c    Initialisation du sous programme orbite qui calcule
+c    a une date donnee de l'annee de duree year_day commencant
+c    a l'equinoxe de printemps et dont le perihelie se situe
+c    a la date peri_day, la distance au soleil et la declinaison.
+c
+c   Interface:
+c   ----------
+c   - Doit etre appele avant d'utiliser orbite.
+c   - initialise une partie du common planete.h
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   aphelie       \   aphelie et perihelie de l'orbite
+c   periheli      /   en millions de kilometres.
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c   Arguments:
+c   ----------
+
+      REAL paphelie,pperiheli,pyear_day,pperi_day,pobliq
+
+c   Local:
+c   ------
+
+      REAL zxref,zanom,zz,zx0,zdx
+      INTEGER iter
+
+c-----------------------------------------------------------------------
+
+      pi=2.*asin(1.)
+
+      aphelie =paphelie
+      periheli=pperiheli
+      year_day=pyear_day
+      obliquit=pobliq
+      peri_day=pperi_day
+
+      PRINT*,'Perihelie en Mkm  ',periheli
+      PRINT*,'Aphelise  en Mkm  ',aphelie 
+      PRINT*,'obliquite en degres  :',obliquit
+      unitastr=149.597927
+      e_elips=(aphelie-periheli)/(periheli+aphelie)
+      p_elips=0.5*(periheli+aphelie)*(1-e_elips*e_elips)/unitastr
+
+      print*,'e_elips',e_elips
+      print*,'p_elips',p_elips
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(year_day-pperi_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      zxref=abs(zanom)
+      PRINT*,'zanom  ',zanom
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
+c  methode de Newton
+
+      zx0=zxref+e_elips*sin(zxref)
+      DO 110 iter=1,100
+         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-12)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+      PRINT*,'zx0   ',zx0
+
+c zteta est la longitude solaire
+
+      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+      PRINT*,'longitude solaire du perihelie timeperi = ',timeperi
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inistats.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inistats.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/inistats.F	(revision 46)
@@ -0,0 +1,112 @@
+      subroutine inistats(ierr)
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+      integer,intent(out) :: ierr
+      integer :: nid
+      integer :: l,nsteppd
+      real, dimension(llm) ::  sig_s
+      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
+      real, dimension(istime) :: lt
+      integer :: nvarid
+
+      write (*,*) 
+      write (*,*) '                        || STATS ||'
+      write (*,*) 
+      write (*,*) 'daysec',daysec
+      write (*,*) 'dtphys',dtphys
+      nsteppd=nint(daysec/dtphys)
+      write (*,*) 'nsteppd=',nsteppd
+      if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+     ,   stop'Dans Instat:  1jour .ne. n pas physiques'
+
+      if(mod(nsteppd,istime).ne.0)
+     ,   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+
+      istats=nsteppd/istime
+      write (*,*) 'istats=',istats
+      write (*,*) 'Storing ',istime,'times per day'
+      write (*,*) 'thus every ',istats,'physical timestep '
+      write (*,*) 
+
+      do l= 1, llm
+         sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+         pseudoalt(l)=-10.*log(presnivs(l)/preff)   
+      enddo
+
+      ierr = NF_CREATE("stats.nc",NF_CLOBBER,nid)
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_lat)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_lon)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid, "llmp1", llm+1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+
+      ierr = NF_ENDDEF(nid)
+      call def_var(nid,"Time","Time",
+     .            "days since 0000-00-0 00:00:00",1,
+     .            idim_time,nvarid,ierr)
+! Time is initialised later by mkstats subroutine
+
+      call def_var(nid,"latitude","latitude","degrees_north",1,
+     .            idim_lat,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+      call def_var(nid,"longitude","East longitude","degrees_east",1,
+     .            idim_lon,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+
+! Niveaux verticaux, aps et bps
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"altitude", NF_DOUBLE, 1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"altitude", NF_FLOAT, 1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",8,"altitude")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif 
+      call def_var(nid,"aps","hybrid pressure at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else 
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      ierr=NF_CLOSE(nid)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/initracer.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/initracer.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/initracer.F	(revision 46)
@@ -0,0 +1,650 @@
+      SUBROUTINE initracer(qsurf,co2ice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialization related to tracer 
+c   (transported dust, water, chemical species, ice...)
+c
+c   Name of the tracer
+c
+c   Test of dimension :
+c   Initialize COMMON tracer in tracer.h, using tracer names provided
+c   by the dynamics in "advtrac.h"
+c
+c   Old conventions: (not used any more)
+c
+c   If water=T : q(iq=nqmx) is the water mass mixing ratio
+c     and q(iq=nqmx-1) is the ice mass mixing ratio
+
+c   If there is transported dust, it uses iq=1 to iq=dustbin
+c   If there is no transported dust : dustbin=0
+c   If doubleq=T : q(iq=1) is the dust mass mixing ratio
+c                  q(iq=2) is the dust number mixing ratio 
+
+c   If (photochem.or.thermochem) there is "ncomp" chemical species (ncomp
+c   is set in aeronomars/chimiedata.h) using the ncomp iq values starting at
+c      iq=nqchem_min = dustbin+1   (nqchem_min is defined in inifis.F)
+c   
+c
+c   author: F.Forget
+c   ------
+c    Modifs: Franck Montmessin, Sebastien Lebonnois (june 2003)
+c            Ehouarn Millour (oct. 2008) identify tracers by their names
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "advtrac.h"
+#include "comgeomfi.h"
+#include "watercap.h"
+#include "chimiedata.h"
+
+
+      real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+      real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+      integer iq,ig,count
+      real r0_lift , reff_lift
+      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+      character(len=20) :: txt ! to store some text
+
+c-----------------------------------------------------------------------
+c  radius(nqmx)      ! aerosol particle radius (m)
+c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+c  qext(nqmx)        ! Single Scat. Extinction coeff at 0.67 um
+c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+c  rho_dust          ! Mars dust density
+c  rho_ice           ! Water ice density
+c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+c  varian            ! Characteristic variance of log-normal distribution
+c-----------------------------------------------------------------------
+
+      integer :: nqchem_start
+
+! Initialization: get tracer names from the dynamics and check if we are
+!                 using 'old' tracer convention ('q01',q02',...)
+!                 or new convention (full tracer names)
+      ! check if tracers have 'old' names
+      oldnames=.false.
+      count=0
+      do iq=1,nqmx
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tnom(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+      
+      if (count.eq.nqmx) then
+        write(*,*) "initracer: tracers seem to follow old naming ",
+     &             "convention (q01,q02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldnames=.true.
+      endif
+
+      ! copy/set tracer names
+      if (oldnames) then ! old names (derived from iq & option values)
+        ! 1. dust:
+        if (dustbin.ne.0) then ! transported dust
+          do iq=1,dustbin
+            txt=" "
+            write(txt,'(a4,i2.2)') 'dust',iq
+            noms(iq)=txt
+            mmol(iq)=100.
+          enddo
+          ! special case if doubleq
+          if (doubleq) then
+            if (dustbin.ne.2) then
+              write(*,*) 'initracer: error expected dustbin=2'
+            else
+              noms(1)='dust_mass'   ! dust mass mixing ratio
+              noms(2)='dust_number' ! dust number mixing ratio
+            endif
+          endif
+        endif
+        ! 2. water & ice
+        if (water) then
+          noms(nqmx)='h2o_vap'
+          mmol(nqmx)=18.
+          noms(nqmx-1)='h2o_ice'
+          mmol(nqmx-1)=18.
+        endif
+        ! 3. Chemistry
+        if (photochem .or. callthermos) then
+          if (doubleq) then
+            nqchem_start=3
+          else
+            nqchem_start=dustbin+1
+          end if
+          do iq=nqchem_start,nqchem_start+ncomp-1
+            noms(iq)=nomchem(iq-nqchem_start+1)
+            mmol(iq)=mmolchem(iq-nqchem_start+1)
+          enddo
+        endif ! of if (photochem .or. callthermos)
+        ! 4. Other tracers ????
+        if ((dustbin.eq.0).and.(.not.water)) then
+          noms(1)='co2'
+          mmol(1)=44
+          if (nqmx.eq.2) then
+            noms(nqmx)='Ar_N2'
+            mmol(nqmx)=30
+          endif
+        endif
+      else
+        ! copy tracer names from dynamics
+        do iq=1,nqmx
+          noms(iq)=tnom(iq)
+        enddo
+        ! mmol(:) array is initialized later (see below)
+      endif ! of if (oldnames)
+
+      ! special modification when using 'old' tracers:
+      ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
+      ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
+      if (oldnames.and.water) then
+        write(*,*)'initracer: moving surface water ice to index ',nqmx-1
+        qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx)
+        qsurf(1:ngridmx,nqmx)=0
+      endif 
+      
+c------------------------------------------------------------
+c     Test Dimensions tracers
+c------------------------------------------------------------
+
+      if(photochem.or.thermochem) then
+          if (water) then
+              if ((dustbin+ncomp+2).ne.nqmx) then
+                 print*,'initracer: tracer dimension problem:'
+                 print*,"(dustbin+ncomp+2).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"dustbin: ",dustbin
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+               endif
+          else
+              if ((dustbin+ncomp+1).ne.nqmx) then
+                 print*,'initracer: tracer dimension problem:'
+                 print*,"(dustbin+ncomp+1).ne.nqmx"
+                 print*,"ncomp: ",ncomp
+                 print*,"dustbin: ",dustbin
+                 print*,"nqmx: ",nqmx
+                 print*,'Change ncomp in chimiedata.h'
+                 STOP
+               endif
+            endif
+      endif
+
+c------------------------------------------------------------
+c         NAME and molar mass of the tracer 
+c------------------------------------------------------------
+
+   
+! Identify tracers by their names: (and set corresponding values of mmol)
+      ! 0. initialize tracer indexes to zero:
+      do iq=1,nqmx
+        igcm_dustbin(iq)=0
+      enddo
+      igcm_dust_mass=0
+      igcm_dust_number=0
+      igcm_h2o_vap=0
+      igcm_h2o_ice=0
+      igcm_co2=0
+      igcm_co=0
+      igcm_o=0
+      igcm_o1d=0
+      igcm_o2=0
+      igcm_o3=0
+      igcm_h=0
+      igcm_h2=0
+      igcm_oh=0
+      igcm_ho2=0
+      igcm_h2o2=0
+      igcm_n2=0
+      igcm_ar=0
+      igcm_ar_n2=0
+
+      ! 1. find dust tracers
+      count=0
+      if (dustbin.gt.0) then
+        do iq=1,nqmx
+          txt=" "
+          write(txt,'(a4,i2.2)')'dust',count+1
+          if (noms(iq).eq.txt) then
+            count=count+1
+            igcm_dustbin(count)=iq
+          endif
+        enddo !do iq=1,nqmx
+      endif ! of if (dustbin.gt.0)
+      if (doubleq) then
+        do iq=1,nqmx
+          if (noms(iq).eq."dust_mass") then
+            igcm_dust_mass=iq
+            count=count+1
+          endif
+          if (noms(iq).eq."dust_number") then
+            igcm_dust_number=iq
+            count=count+1
+          endif
+        enddo
+      endif ! of if (doubleq)
+      ! 2. find chemistry and water tracers
+      do iq=1,nqmx
+        if (noms(iq).eq."co2") then
+          igcm_co2=iq
+          mmol(igcm_co2)=44.
+          count=count+1
+        endif
+        if (noms(iq).eq."co") then
+          igcm_co=iq
+          mmol(igcm_co)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."o") then
+          igcm_o=iq
+          mmol(igcm_o)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o1d") then
+          igcm_o1d=iq
+          mmol(igcm_o1d)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o2") then
+          igcm_o2=iq
+          mmol(igcm_o2)=32.
+          count=count+1
+        endif
+        if (noms(iq).eq."o3") then
+          igcm_o3=iq
+          mmol(igcm_o3)=48.
+          count=count+1
+        endif
+        if (noms(iq).eq."h") then
+          igcm_h=iq
+          mmol(igcm_h)=1.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2") then
+          igcm_h2=iq
+          mmol(igcm_h2)=2.
+          count=count+1
+        endif
+        if (noms(iq).eq."oh") then
+          igcm_oh=iq
+          mmol(igcm_oh)=17.
+          count=count+1
+        endif
+        if (noms(iq).eq."ho2") then
+          igcm_ho2=iq
+          mmol(igcm_ho2)=33.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o2") then
+          igcm_h2o2=iq
+          mmol(igcm_h2o2)=34.
+          count=count+1
+        endif
+        if (noms(iq).eq."n2") then
+          igcm_n2=iq
+          mmol(igcm_n2)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."ar") then
+          igcm_ar=iq
+          mmol(igcm_ar)=40.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_vap") then
+          igcm_h2o_vap=iq
+          mmol(igcm_h2o_vap)=18.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_ice") then
+          igcm_h2o_ice=iq
+          mmol(igcm_h2o_ice)=18.
+          count=count+1
+        endif
+        ! Other stuff: e.g. for simulations using co2 + neutral gaz
+        if (noms(iq).eq."Ar_N2") then
+          igcm_ar_n2=iq
+          mmol(igcm_ar_n2)=30.
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+!      count=count+nbqchem
+      
+      ! check that we identified all tracers:
+      if (count.ne.nqmx) then
+        write(*,*) "initracer: found only ",count," tracers"
+        write(*,*) "               expected ",nqmx
+        do iq=1,count
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+        stop
+      else
+        write(*,*) "initracer: found all expected tracers, namely:"
+        do iq=1,nqmx
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+      endif
+
+      ! if water cycle but iceparty=.false., there will nevertheless be
+      ! water ice at the surface (iceparty is not used anymore, but this
+      ! part is still relevant, as we want to stay compatible with the
+      ! older versions).
+      if (water.and.(igcm_h2o_ice.eq.0)) then
+        igcm_h2o_ice=igcm_h2o_vap ! so that qsurf(i_h2o_ice) is identified
+                                  ! even though there is no q(i_h2o_ice)
+      else
+       ! surface ice qsurf(i_h2o_ice) was loaded twice by phyetat0,
+       ! as qsurf(i_h2o_vap) & as qsurf(i_h2o_ice), so to be clean:
+       if (igcm_h2o_vap.ne.0) then
+         qsurf(1:ngridmx,igcm_h2o_vap)=0
+       endif
+      endif
+
+c------------------------------------------------------------
+c     Initialisation tracers ....
+c------------------------------------------------------------
+      call zerophys(nqmx,rho_q)
+
+      rho_dust=2500.  ! Mars dust density (kg.m-3)
+      rho_ice=920.    ! Water ice density (kg.m-3)
+
+      if (doubleq) then
+c       "doubleq" technique 
+c       -------------------
+c      (transport of mass and number mixing ratio)
+c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+
+!        if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+!          write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+!          write(*,*)'water= ',water,' doubleq= ',doubleq   
+!        end if
+
+        varian=0.637    ! Characteristic variance    
+        qext(igcm_dust_mass)=3.04   ! reference extinction at 0.67 um for ref dust
+        qext(igcm_dust_number)=3.04 ! reference extinction at 0.67 um for ref dust
+        rho_q(igcm_dust_mass)=rho_dust
+        rho_q(igcm_dust_number)=rho_dust
+
+c       Intermediate calcul for computing geometric mean radius r0
+c       as a function of mass and number mixing ratio Q and N
+c       (r0 = (r3n_q * Q/ N)
+        r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+
+c       Intermediate calcul for computing effective radius reff
+c       from geometric mean radius r0
+c       (reff = ref_r0 * r0)
+        ref_r0 = exp(2.5*varian**2)
+        
+c       lifted dust :
+c       '''''''''''
+        reff_lift = 3.e-6      !  Effective radius of lifted dust (m)
+        alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+        alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+
+        r0_lift = reff_lift/ref_r0
+        alpha_devil(igcm_dust_number)=r3n_q*
+     &                        alpha_devil(igcm_dust_mass)/r0_lift**3
+        alpha_lift(igcm_dust_number)=r3n_q*
+     &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+
+c       Not used:
+        radius(igcm_dust_mass) = 0.
+        radius(igcm_dust_number) = 0.
+
+      endif ! of if (doubleq)
+
+      if (dustbin.gt.0) then
+        if (dustbin.eq.1) then
+c
+c       This will be used for 1 dust particle size:
+c       ------------------------------------------
+          radius(igcm_dustbin(1))=3.e-6
+          Qext(igcm_dustbin(1))=3.04
+          alpha_lift(igcm_dustbin(1))=0.0e-6
+          alpha_devil(igcm_dustbin(1))=7.65e-9
+          qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+     &                         /(rho_dust*radius(igcm_dustbin(1)))
+          rho_q(igcm_dustbin(1))=rho_dust
+        else
+          write(*,*) "initracer: properties of dust need to be set",
+     &              " in initracer !!!"
+          stop
+        endif ! of if (dustbin.eq.1)
+      endif ! of if (dustbin.gt.0)
+
+c     Initialization for photochemistry:
+c     ---------------------------------
+      if (photochem) then
+      ! initialize chemistry+water (water will be correctly initialized below)
+      ! by initializing everything which is not dust ...
+        do iq=1,nqmx
+          txt=noms(iq)
+          if (txt(1:4).ne."dust") then
+            radius(iq)=0.
+            Qext(iq)=0.
+            alpha_lift(iq) =0.
+            alpha_devil(iq)=0.
+	    qextrhor(iq)= 0.
+          endif
+        enddo ! do iq=1,nqmx
+      endif
+
+c     Initialization for water vapor
+c     ------------------------------
+      if(water) then
+         radius(igcm_h2o_vap)=0.
+         Qext(igcm_h2o_vap)=0.
+         alpha_lift(igcm_h2o_vap) =0.
+         alpha_devil(igcm_h2o_vap)=0.
+	 qextrhor(igcm_h2o_vap)= 0.
+
+c       "Dryness coefficient" controlling the evaporation and
+c        sublimation from the ground water ice (close to 1)
+c        HERE, the goal is to correct for the fact
+c        that the simulated permanent water ice polar caps
+c        is larger than the actual cap and the atmospheric
+c        opacity not always realistic.
+
+         do ig=1,ngridmx
+           if (ngridmx.ne.1) watercaptag(ig)=.false.
+           dryness(ig) = 1.
+         enddo
+
+         IF (caps) THEN
+c Perennial H20 north cap defined by watercaptag=true (allows surface to be
+c hollowed by sublimation in vdifc).
+         do ig=1,ngridmx
+           if (lati(ig)*180./pi.gt.84) then
+             if (ngridmx.ne.1) watercaptag(ig)=.true.
+             dryness(ig) = 1.
+c Use the following cap definition for high spatial resolution (latitudinal bin <= 5 deg)
+c	      if (lati(ig)*180./pi.lt.85.and.long(ig).ge.0) then
+c	        if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+c             if (lati(ig)*180./pi.ge.85) then
+c               if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+           endif  ! (lati>80 deg)
+         end do ! (ngridmx)
+        ENDIF ! (caps)
+
+         if(water.and.(nqmx.ge.2)) then
+           radius(igcm_h2o_ice)=3.e-6
+           rho_q(igcm_h2o_ice)=rho_ice
+           Qext(igcm_h2o_ice)=0.
+           alpha_lift(igcm_h2o_ice) =0.
+           alpha_devil(igcm_h2o_ice)=0.
+           qextrhor(igcm_h2o_ice)= (3./4.)*Qext(igcm_h2o_ice) 
+     $       / (rho_ice*radius(igcm_h2o_ice))
+         elseif(water.and.(nqmx.lt.2)) then
+            write(*,*) 'nqmx is too low : nqmx=', nqmx
+            write(*,*) 'water= ',water
+         endif
+
+      end if  ! (water)
+
+c     Output for records:
+c     ~~~~~~~~~~~~~~~~~~
+      write(*,*)
+      Write(*,*) '******** initracer : dust transport parameters :'
+      write(*,*) 'alpha_lift = ', alpha_lift
+      write(*,*) 'alpha_devil = ', alpha_devil
+      write(*,*) 'radius  = ', radius
+      if(doubleq) then
+        write(*,*) 'reff_lift (um) =  ', reff_lift
+        write(*,*) 'size distribution variance  = ', varian
+        write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+      end if
+      write(*,*) 'Qext  = ', qext 
+      write(*,*)
+
+!
+!     some extra sanity checks for tracers: 
+!     ------------------------------------
+
+       if (doubleq) then 
+       ! verify that we indeed have dust_mass and dust_number tracers 
+         if (igcm_dust_mass.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use doubleq option without ",
+     &                "a dust_mass tracer !"
+           stop
+         endif
+         if (igcm_dust_number.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use doubleq option without ",
+     &                "a dust_number tracer !"
+           stop
+         endif
+       endif
+
+       if (dustbin.gt.0) then
+       ! verify that we indeed have 'dustbin' dust tracers
+         count=0
+         do iq=1,dustbin
+           if (igcm_dustbin(iq).ne.0) then
+             count=count+1
+           endif
+         enddo
+         if (count.ne.dustbin) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  dusbin is set to ",dustbin,
+     &                " but we only have the following dust tracers:"
+           do iq=1,count
+             write(*,*)"   ",trim(noms(igcm_dustbin(iq)))
+           enddo
+           stop
+         endif
+       endif
+
+       if (water) then
+       ! verify that we indeed have h2o_vap and h2o_ice tracers
+         if (igcm_h2o_vap.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use water option without ",
+     &                "an h2o_vap tracer !"
+           stop
+         endif
+         if (igcm_h2o_ice.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use water option without ",
+     &                "an h2o_ice tracer !"
+           stop
+         endif
+       endif
+
+       if (photochem .or. callthermos) then
+       ! verify that we indeed have the chemistry tracers
+         if (igcm_co2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a co2 tracer !"
+         stop
+         endif
+         if (igcm_co.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a co tracer !"
+         stop
+         endif
+         if (igcm_o.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a o tracer !"
+         stop
+         endif
+         if (igcm_o1d.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a o1d tracer !"
+         stop
+         endif
+         if (igcm_o2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an o2 tracer !"
+         stop
+         endif
+         if (igcm_o3.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an o3 tracer !"
+         stop
+         endif
+         if (igcm_h.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h tracer !"
+         stop
+         endif
+         if (igcm_h2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h2 tracer !"
+         stop
+         endif
+         if (igcm_oh.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an oh tracer !"
+         stop
+         endif
+         if (igcm_ho2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a ho2 tracer !"
+         stop
+         endif
+         if (igcm_h2o2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h2o2 tracer !"
+         stop
+         endif
+         if (igcm_n2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a n2 tracer !"
+         stop
+         endif
+         if (igcm_ar.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an ar tracer !"
+         stop
+         endif
+       endif ! of if (photochem .or. callthermos)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwrite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwrite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwrite.F	(revision 46)
@@ -0,0 +1,359 @@
+      SUBROUTINE iniwrite(nid,idayref,phis)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   'Initialize' the diagfi.nc file: write down dimensions as well
+c   as time-independent fields (e.g: geopotential, mesh area, ...)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+!include "comconst.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include"dimphys.h"
+#include"comsoil.h"
+
+c   Arguments:
+c   ----------
+
+      integer nid        ! NetCDF file ID
+      INTEGER*4 idayref  ! date (initial date for this run)
+      REAL phis(ip1jmp1) ! surface geopotential
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! run parameters are stored in this array
+      INTEGER ierr
+
+      integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+      integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
+      integer, dimension(2) :: id  
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = real(iim)
+      tab_cntrl(2)  = real(jjm)
+      tab_cntrl(3)  = real(llm)
+      tab_cntrl(4)  = real(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Define dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "interlayer", (llm+1), idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+c
+      ierr = NF_ENDDEF(nid)
+
+c  Contol parameters for this run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                       "Control parameters")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  longitudes and latitudes
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
+     .                       "Longitudes at u nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, 
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, 
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+     .                       "Latitudes at v nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
+#endif
+c
+c --------------------------
+c  Vertical levels
+      call def_var(nid,"aps","hybrid pressure at midlayers ","Pa",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+
+      call def_var(nid,"bps","hybrid sigma at midlayers"," ",
+     .            1,idim_llm,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+
+      call def_var(nid,"ap","hybrid pressure at interlayers","Pa",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+
+      call def_var(nid,"bp","hybrid sigma at interlayers"," ",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+c
+c --------------------------
+c  Mesh area and conversion coefficients cov. <-> contra. <--> natural
+
+      id(1)=idim_rlonu
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatv
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c  Surface geopotential
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .                       "Geopotential at the surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+
+      write(*,*)'iniwrite: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      write(*,*)'iniwrite: rad,omeg,g,mugaz,rcp',
+     s rad,omeg,g,mugaz,rcp
+      write(*,*)'iniwrite: daysec,dtphys',daysec,dtphys
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwritesoil.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwritesoil.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/iniwritesoil.F90	(revision 46)
@@ -0,0 +1,272 @@
+subroutine iniwritesoil(nid)
+
+! initialization routine for 'writediagoil'. Here we create/define
+! dimensions (longitude, latitude, depth and time) and other fixed
+! (time-independent) parameters.
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"paramet.h"
+#include"comcstfi.h"
+#include"comgeom.h"
+#include"comsoil.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: nid ! NetCDF output file ID
+
+! Local variables:
+
+! NetCDF stuff:
+integer :: ierr ! NetCDF routines return code
+integer :: idim_rlatu ! ID of the 'latitude' dimension
+integer :: idim_rlonv ! ID of the 'longitude' dimension
+integer :: idim_depth ! ID of the 'depth' dimension
+integer :: idim_time  ! ID of the 'time' dimension
+integer :: varid ! to store NetCDF ID of a variable
+integer,dimension(3) :: dimids ! to store IDs of dimensions of a variable
+character(len=60) :: text ! to store some text
+real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+integer :: i,j,l,ig0
+
+! 1. Define the dimensions
+! Switch to NetCDF define mode
+ierr=NF_REDEF(nid)
+
+! Define the dimensions
+ierr=NF_DEF_DIM(nid,"longitude",iip1,idim_rlonv)
+! iip1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"latitude",jjp1,idim_rlatu)
+! jjp1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"depth",nsoilmx,idim_depth)
+! nsoilmx known from dimphys.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth dimension"
+endif
+ierr=NF_DEF_DIM(nid,"time",NF_UNLIMITED,idim_time)
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define time dimension"
+endif
+
+! Switch out of NetCDF define mode
+ierr=NF_ENDDEF(nid)
+
+! 2. Define (as variables) and write dimensions, as well as their attributes
+! 2.1. Longitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,varid)
+#else
+ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude variable"
+endif
+
+! Longitude attributes
+text="East longitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_east"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write longitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlonv*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlonv*(180./pi))
+#endif
+! Note: rlonv is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.2. Latitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,varid)
+#else
+ierr=NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude variable"
+endif
+
+! Latitude attributes
+text="North latitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_north"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write latitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlatu*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlatu*(180./pi))
+#endif
+! Note: rlatu is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.3. Depth
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"depth",NF_DOUBLE,1,idim_depth,varid)
+#else
+ierr=NF_DEF_VAR(nid,"depth",NF_FLOAT,1,idim_depth,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! Depth attributes
+text="Soil mid-layer depth"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+text="down"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"positive",len_trim(text),text)
+
+! Write depth to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,mlayer)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,mlayer)
+#endif
+! Note mlayer(0:nsoilmx-1) known from comsoil.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write depth variable"
+endif
+
+! 2.4. Time
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"time",NF_DOUBLE,1,idim_time,varid)
+#else
+ierr=NF_DEF_VAR(nid,"time",NF_FLOAT,1,idim_time,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! time attributes
+text="Time"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="days since 0000-01-01 00:00:00"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Note no need to write time variable here; it is done in writediagsoil.
+
+! 3. Other variables to be included
+
+! 3.1 mesh area surrounding each horizontal point
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"area",NF_DOUBLE,2,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"area",NF_FLOAT,2,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define area variable"
+endif
+
+! Area attributes
+text="Mesh area"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m2"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write area to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,aire)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,aire)
+#endif
+! Note: aire is known from comgeom.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write area variable"
+endif
+
+! 3.2 Thermal inertia
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+dimids(3)=idim_depth ! ID of the 'depth' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_DOUBLE,3,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_FLOAT,3,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define th_inertia variable"
+endif
+
+! Attributes
+text="Thermal inertia"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="J.s-1/2.m-2.K-1"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Recast data along 'dynamics' grid
+! Note: inertiedat is known from comsoil.h
+
+do l=1,nsoilmx
+  ! handle the poles
+  do i=1,iip1
+    data3(i,1,l)=inertiedat(1,l)
+    data3(i,jjp1,l)=inertiedat(ngridmx,l)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data3(i,j,l)=inertiedat(ig0+i,l)
+    enddo
+    data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+  enddo
+enddo ! of do l=1,nsoilmx
+
+! Write data2 to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,data3)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,data3)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write th_inertia variable"
+endif
+
+end subroutine iniwritesoil
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/interp_line.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/interp_line.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/interp_line.F	(revision 46)
@@ -0,0 +1,55 @@
+      subroutine interp_line(x1,y1,len1,x2,y2,len2)
+      implicit none
+!-----------------------------------------------------------------------
+!
+!  Purpose: Do a series of linear interpolations
+!  Data sets are organized as vectors (see below)
+!  If x2(:), and abscissa at which interpolation is requiered, lies
+!  outside of the interval covered by x1(:), instead of doing an
+!  extrapolation, y2() is set to the value y1() corresponding to
+!  the nearby x1(:) point
+!  
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      real x1(len1) ! ordered list of abscissas
+      real y1(len1) ! values at x1(:)
+      integer len1  ! length of x1(:) and y1(:)
+      real x2(len2) !ordered list of abscissas at which interpolation is done
+      integer len2  ! length of x2(:) and y2(:)
+!  outputs:
+      real y2(len2) ! interpolated values
+!-----------------------------------------------------------------------
+
+! local variables:
+      integer i,j
+      
+
+      do i=1,len2
+        ! check if x2(i) lies outside of the interval covered by x1()
+        if(((x2(i).le.x1(1)).and.(x2(i).le.x1(len1))).or.
+     &     ((x2(i).ge.x1(1)).and.(x2(i).ge.x1(len1)))) then
+	  ! set y2(i) to y1(1) or y1(len1)
+	  if (abs(x2(i)-x1(1)).lt.abs(x2(i)-x1(len1))) then
+	    ! x2(i) lies closest to x1(1)
+	    y2(i)=y1(1)
+	  else
+	    ! x2(i) lies closest to x1(len1)
+	    y2(i)=y1(len1)
+	  endif
+
+	else
+        ! find the nearest neigbours and do a linear interpolation
+	 do j=1,len1-1
+          if(((x2(i).ge.x1(j)).and.(x2(i).le.x1(j+1))).or.
+     &       ((x2(i).le.x1(j)).and.(x2(i).ge.x1(j+1)))) then
+	    y2(i)=((x2(i)-x1(j))/(x1(j+1)-x1(j)))*y1(j+1)+
+     &            ((x2(i)-x1(j+1))/(x1(j)-x1(j+1)))*y1(j)
+	  endif
+	 enddo
+	endif
+
+      enddo
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismax.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismax.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismax.F	(revision 46)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismin.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismin.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/ismin.F	(revision 46)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+      ix=ix+incx
+      if(sx(ix).lt.sxmin) then
+        sxmin=sx(ix)
+        ismin=i+1
+      endif
+      ENDDO
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwb.F	(revision 46)
@@ -0,0 +1,140 @@
+      subroutine lwb (kdlon,kflev,tlev,tlay,dt0
+     .               ,bsurf,btop,blay,blev,dblay,dbsublay)
+ 
+c----------------------------------------------------------------------
+c     LWB  computes the planck function and gradient
+c          from a polynomial development of planck function
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nalyer
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+c                                                            outputs:
+c                                                            --------
+      real bsurf (ndlo2,nir)        ! surface spectral planck function
+      real btop (ndlo2,nir)         ! top spectral planck function
+      real blev (ndlo2,nir,kflev+1) ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)   ! layer   spectral planck function
+      real dblay (ndlo2,nir,kflev)  ! layer gradient spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jk, jl, jnu, jk1, jk2
+
+      real ztlay (ndlon)
+      real ztlev (ndlon)
+
+c----------------------------------------------------------------------
+      do jnu=1,nir
+c----------------------------------------------------------------------
+c         1.1   levels and layers from surface to nlaylte
+c               ---------------------------------------
+
+      do jk = 1 , nlaylte
+        do jl = 1 , kdlon
+
+c                                                  level planck function 
+c                                                  ---------------------
+      ztlev(jl)=(tlev(jl,jk)-tstand)/tstand    ! tstand = 200k
+
+      blev(jl,jnu,jk)   = xp(1,jnu)
+     .                    +ztlev(jl)*(xp(2,jnu) 
+     .                    +ztlev(jl)*(xp(3,jnu) 
+     .                    +ztlev(jl)*(xp(4,jnu) 
+     .                    +ztlev(jl)*(xp(5,jnu)
+     .                    +ztlev(jl)*(xp(6,jnu)    )))))
+
+c                                                  layer planck function 
+c                                                  ---------------------
+      ztlay(jl)=(tlay(jl,jk)-tstand)/tstand
+
+      blay(jl,jnu,jk) = xp(1,jnu)
+     .                  +ztlay(jl)*(xp(2,jnu)
+     .                  +ztlay(jl)*(xp(3,jnu)
+     .                  +ztlay(jl)*(xp(4,jnu)
+     .                  +ztlay(jl)*(xp(5,jnu)
+     .                  +ztlay(jl)*(xp(6,jnu)    )))))
+
+c                                               planck function gradient
+c                                               ------------------------
+      dblay(jl,jnu,jk) = xp(2,jnu)
+     .                   +ztlay(jl)*(2*xp(3,jnu)
+     .                   +ztlay(jl)*(3*xp(4,jnu)
+     .                   +ztlay(jl)*(4*xp(5,jnu)
+     .                   +ztlay(jl)*(5*xp(6,jnu)  ))))
+      dblay(jl,jnu,jk) = dblay(jl,jnu,jk)/tstand
+
+        enddo
+      enddo
+     
+c----------------------------------------------------------------------
+c         1.2   top of the atmosphere and surface
+c               --------------------------------
+
+      do jl = 1 , kdlon
+c                                                  top of the atmosphere
+c                                                  ---------------------
+      ztlev(jl) = (tlev(jl,nlaylte+1)-tstand)/tstand
+
+      blev(jl,jnu,nlaylte+1) = xp(1,jnu)
+     .                       +ztlev(jl)*(xp(2,jnu)
+     .                       +ztlev(jl)*(xp(3,jnu)
+     .                       +ztlev(jl)*(xp(4,jnu)
+     .                       +ztlev(jl)*(xp(5,jnu)
+     .                       +ztlev(jl)*(xp(6,jnu)    )))))
+      btop(jl,jnu) = blev(jl,jnu,nlaylte+1)
+
+c                                                                surface
+c                                                                -------
+      ztlay(jl) = (tlev(jl,1)+dt0(jl)-tstand)/tstand
+
+      bsurf(jl,jnu) = xp(1,jnu)
+     .               +ztlay(jl)*(xp(2,jnu)
+     .               +ztlay(jl)*(xp(3,jnu)
+     .               +ztlay(jl)*(xp(4,jnu)
+     .               +ztlay(jl)*(xp(5,jnu)
+     .               +ztlay(jl)*(xp(6,jnu)     )))))
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.3   Gradients in sub-layers
+c               -----------------------
+
+      do jk=1,nlaylte
+        jk2 = 2 * jk
+        jk1 = jk2 - 1 
+          do jl=1,kdlon
+            dbsublay(jl,jnu,jk1)=blay(jl,jnu,jk)-blev(jl,jnu,jk)
+            dbsublay(jl,jnu,jk2)=blev(jl,jnu,jk+1)-blay(jl,jnu,jk)
+          enddo
+      enddo
+
+c----------------------------------------------------------------------
+      enddo           ! (do jnu=1,nir)
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwdiff.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwdiff.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwdiff.F	(revision 46)
@@ -0,0 +1,219 @@
+      subroutine lwdiff (kdlon,kflev
+     .         ,pbsur,pbtop,pdbsl
+     .         ,tautotal,omegtotal,gtotal
+     .         ,pemis,pfluc)
+
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+C-----------------------------------------------------------------------
+C
+c  ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
+c! 1) Dans la bande a 15 micron (CO2), les poussieres 
+c! n'interviennent que comme un milieu gris non diffusif avec 
+c!                      Q=Qext*(1-Omega)
+c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
+c! pour lesquelles les parametres optiques des poussieres sont
+c! identiques
+c! 2)  le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
+c! les longueurs d'onde inferieures a celles de la bande a 15 microns
+c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
+c! (indices 4...nir) sur chacune de ces  bandes, les poussieres
+c! sont supposees diffusantes grises.
+c!
+C
+C-----------------------------------------------------------------------
+C
+C
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kdlon,kflev
+      REAL PBSUR(NDLO2,nir), PBTOP(NDLO2,nir)
+     S  ,  PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)
+
+      real PFLUC(NDLO2,2,KFLEV+1)
+      real tautotal(ndlon,nflev,nir)
+      real omegtotal(ndlon,nflev,nir), gtotal(ndlon,nflev,nir)
+
+C
+C
+C-------------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      integer jl, jk, ndd, indd, iir, j1
+      integer  j2, j2dd2, j2dd1,j2bot,j2top, j2dd
+      REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1)
+     S  ,  ZDBDT(NDLON,nir,NFLEV)
+     S  ,  ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1)
+     S  ,  ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON)
+     S  ,  ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON)
+     S  ,  ZOMEGADD(NDLON,NFLEV*2),ZGDD(NDLON,NFLEV*2)
+     S  ,  ZTAUDD(NDLON,NFLEV*2)
+     S  ,  ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON)
+     S  ,  ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON)
+     S  ,  ZFAHDD(NDLON,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1)
+     S  ,  ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
+C                  ------------------------------
+C
+ 110  CONTINUE
+C
+
+      do jl = 1 , kdlon
+        do jk = 1 , nlaylte
+          PFLUC(jl,1,jk) = 0.
+          PFLUC(jl,2,jk) = 0.
+        enddo
+      enddo
+
+      DO 112 JK = 1 , nlaylte+1
+        DO 111 JL = 1 , KDLON
+          ZADJD(JL,JK) = 0.
+          ZADJU(JL,JK) = 0.
+          ZDISD(JL,JK) = 0.
+          ZDISU(JL,JK) = 0.
+ 111    CONTINUE
+ 112  CONTINUE
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.      VERTICAL INTEGRATION
+C                  --------------------
+C
+C     ------------------------------------------------------------------
+C
+C
+C  ==================================================================
+C*         2.0     contribution des bandes "hors co2"
+C  ==================================================================
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.1   preparation des Planck a chaque hauteur
+C                  ----------------------------------
+C
+c!
+c! le nombre de couche pour la diffusion sera le nombre de layer * 2
+c! soit NDD=nlaylte*2, donc la taille du vecteur des Planck sera
+c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
+c! par contre nlaylte*2 (voir dans FLUSV.F).
+c!
+      NDD=nlaylte*2
+      DO indd=1,ndd+1
+                                            do jl=1,kdlon
+         ZFAHDD(jl,indd)=0.
+         ZFDHDD(jl,indd)=0.
+         ZBHDD(jl,indd)=0.
+                                            enddo
+      ENDDO
+                                            do jl=1,kdlon
+      ZBSDD(jl)=0.
+                                            enddo
+c!
+c! boucle sur les  bandes hors CO2
+c!
+      DO 10001 iir=3,nir
+c!
+                                            do jl=1,kdlon
+        ZZBHDD(JL,1)=PBTOP(JL,iir)/pi
+                                            enddo
+        DO J1=2,NDD+1
+                                            do jl=1,kdlon
+           ZZBHDD(JL,J1)=
+     &     ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/pi
+                                            enddo
+        ENDDO
+                                            do jl=1,kdlon
+        ZZBSDD(JL)=PBSUR(JL,iir)/pi
+                                            enddo
+
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.2   preparation des coefficients de diffusion
+C                  -----------------------------------------
+C
+c! les omega, g, tau ... boucle de bas en haut
+        DO J2=1,nlaylte-1
+          J2DD2=(nlaylte-J2+1)*2
+          J2DD1=J2DD2-1
+          J2BOT=3*J2-2
+          J2TOP=3*J2+1
+          do jl=1,kdlon
+            ZTAUDD(JL,J2DD1)=tautotal(jl,J2,iir)*0.5
+            ZTAUDD(JL,J2DD2)=ZTAUDD(JL,J2DD1)
+            ZOMEGADD(JL,J2DD1)=omegtotal(jl,J2,iir)
+            ZOMEGADD(JL,J2DD2)=omegtotal(jl,J2,iir)
+            ZGDD(JL,J2DD1)=gtotal(jl,J2,iir)
+            ZGDD(JL,J2DD2)=gtotal(jl,J2,iir)
+          enddo
+        ENDDO
+        J2=nlaylte
+        J2DD2=2
+        J2DD1=1
+        J2BOT=3*J2-2
+                                            do jl=1,kdlon
+        ZTAUDD(JL,J2DD1)= tautotal(jl,J2,iir)*0.5
+        ZTAUDD(JL,J2DD2)= tautotal(jl,J2,iir)*0.5
+        ZOMEGADD(JL,J2DD1)= omegtotal(jl,J2,iir)
+        ZOMEGADD(JL,J2DD2)= omegtotal(jl,J2,iir)
+        ZGDD(JL,J2DD1)= gtotal(jl,J2,iir)
+        ZGDD(JL,J2DD2)= gtotal(jl,J2,iir)
+                                            enddo
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.3   calcul de la diffusion
+C                  ----------------------
+C
+
+c-----------------------------------------------------------------------
+        CALL flusv(KDLON,0
+     &  ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
+     &  ,ZZBHDD,ZZBSDD
+     &  ,ZZFAHDD,ZZFDHDD)
+c!
+c!  Cumul des flux sur le spectre hors bande du CO2
+c!
+        DO indd=1,ndd+1
+           do jl=1,kdlon
+             ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd)
+             ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd)
+           enddo
+        ENDDO
+10001 CONTINUE
+
+      DO J2=1,nlaylte+1
+        J2DD=(nlaylte-J2+1)*2+1
+        do jl=1,kdlon
+          PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD)
+          PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD)
+        enddo
+      ENDDO
+
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux.F	(revision 46)
@@ -0,0 +1,513 @@
+       subroutine lwflux (ig0,kdlon,kflev,dp
+     .                   ,bsurf,btop,blev,blay,dbsublay
+     .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .                   ,emis
+     .                   , tautotal,omegtotal,gtotal
+     .                   ,coolrate,fluxground,fluxtop
+     .                   ,netrad)
+
+c----------------------------------------------------------------------
+c     LWFLUX     computes the fluxes
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon                 ! part of ngrid
+      integer kflev                 ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+
+      real bsurf (ndlo2,nir)             ! surface spectral planck function
+      real blev (ndlo2,nir,kflev+1)      ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)        ! layer   spectral planck function
+      real btop (ndlo2,nir)              ! top spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+      real emis (ndlo2)                  ! surface emissivity
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols prop.)
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)    ! radiative cooling rate (K/s) 
+      real netrad (ndlo2,kflev)     ! radiative budget (W/m2) 
+      real fluxground(ndlo2)        ! downward flux on the ground
+                                    ! for surface radiative budget
+      real fluxtop(ndlo2)           ! upward flux on the top of atm ("OLR")
+
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,j,i,ig1d,ig,l,ndim
+      parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
+      real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
+
+      real dpsgcp (0:nflev+1,0:nflev+1)    !  dp/(g.cp)
+      real temp (0:nflev+1,0:nflev+1)       
+
+      real fluxdiff(ndlon,2,nflev+1)  ! diffusion flux: upward(1) downward(2) 
+
+      real*4 reel4
+
+c     To compute IR flux in the atmosphere  (For diagnostic only !!)
+      logical computeflux
+      real coefd(ngridmx,nuco2,nflev+1,nflev+1) 
+      real coefu(ngridmx,nuco2,0:nflev,nflev+1)
+      real flw_up(ngridmx,nflev+1), flw_dn(ngridmx,nflev+1) ! fluxes (W/m2)
+
+
+      call zerophys(ndim, ksidb)
+
+c----------------------------------------------------------------------
+c         1.1   exchanges (layer i <--> all layers up to i) 
+c               -------------------------------------------
+
+      do i = 1,nlaylte
+        do j = i+1,nlaylte
+          do ja = 1,nuco2
+            do jl = 1,kdlon
+
+      ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j)
+     .                 * (blay(jl,ja,j)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,j,i) = -ksidb(jl,ja,i,j)
+      
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   exchanges (ground <--> all layers) 
+c               ----------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i)
+     .                 * (bsurf(jl,ja)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,0,i) = -ksidb(jl,ja,i,0)
+
+          enddo
+        enddo
+      enddo
+
+c--------------------------------------------------------
+c  Here we add the neighbour contribution 
+c           for exchanges between ground and first layer
+c--------------------------------------------------------
+
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
+     .                 - xi_ground(ig0+jl,ja)
+     .                 * (blev(jl,ja,1)-blay(jl,ja,1))
+
+cc                                                       ksidb reciprocity
+cc                                                       -----------------
+      ksidb(jl,ja,0,1) = - ksidb(jl,ja,1,0)
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         1.3   exchanges (layer i <--> space) 
+c               ------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) 
+     .                       * (-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,i) = - ksidb(jl,ja,i,nlaylte+1)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.4   exchanges (ground <--> space) 
+c               -----------------------------
+
+      do ja = 1,nuco2
+        do jl = 1,kdlon
+
+      ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) 
+     .                       * (-bsurf(jl,ja))
+
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,0) = - ksidb(jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   sum of band 1 and 2 of co2 contribution 
+c               ---------------------------------------
+
+      do i = 0,nlaylte+1
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            ksidb(jl,3,i,j)= ksidb(jl,1,i,j) + ksidb(jl,2,i,j)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         3.0   Diffusion
+c               ---------
+
+      i = nlaylte+1
+      do jl = 1,kdlon
+        fluxdiff(jl,1,i)   = 0.
+        fluxdiff(jl,2,i)   = 0.
+      enddo
+
+      call lwdiff (kdlon,kflev
+     .         ,bsurf,btop,dbsublay
+     .         ,tautotal,omegtotal,gtotal
+     .         ,emis,fluxdiff)
+
+c----------------------------------------------------------------------
+c         4.0   Radiative Budget for each layer i
+c               ---------------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+            netrad(jl,i) = 0.
+        enddo
+      enddo
+
+      do i = 1,nlaylte
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            netrad(jl,i) = netrad(jl,i) + ksidb(jl,3,i,j)
+
+          enddo
+        enddo
+      enddo
+c                                                 diffusion contribution
+c                                                 ----------------------
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          netrad(jl,i) = netrad(jl,i) 
+     .                 - fluxdiff(jl,1,i+1) - fluxdiff(jl,2,i+1)   
+     .                 + fluxdiff(jl,1,i)   + fluxdiff(jl,2,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate for each layer i
+c               -----------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          coolrate(jl,i) = gcp * netrad(jl,i) / dp(jl,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         5.0   downward flux (all layers --> ground): "fluxground" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxground(jl) = 0.
+      enddo
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      fluxground(jl) = fluxground(jl)
+     .               + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
+
+          enddo
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxground(jl) = fluxground(jl) - fluxdiff(jl,2,1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.0   outgoing flux (all layers --> space): "fluxtop" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxtop(jl) = 0.
+      enddo
+
+      do i = 0,nlaylte
+        do jl = 1,kdlon
+           fluxtop(jl) = fluxtop(jl)- ksidb(jl,3,i,nlaylte+1)
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxtop(jl) = fluxtop(jl) + fluxdiff(jl,1,nlaylte+1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.5 ONLY FOR DIAGNOSTIC : Compute IR flux in the atmosphere 
+c             -------------------
+c     The broadband fluxes (W.m-2) at every level  from surface level (l=1) 
+c     up the top of the  upper layer (here: l=nlaylte+1) are:
+c     upward : flw_up(ig1d,l)   ;   downward : flw_dn(ig1d,j) 
+c
+      computeflux = .false.
+
+      IF (computeflux) THEN  ! not used by the GCM only for diagnostic !
+c      upward flux 
+c      ~~~~~~~~~~~
+       do i = 0,nlaylte
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefu(jl,ja,i,j) =0.
+            do l=j,nlaylte+1 
+              coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_up(jl,j) = 0.
+           do ja = 1,nuco2
+             flw_up(jl,j)=flw_up(jl,j)+bsurf(jl,ja)*coefu(jl,ja,0,j)
+             do i=1,j-1
+              flw_up(jl,j)=flw_up(jl,j)+blay(jl,ja,i)*coefu(jl,ja,i,j) 
+             end do 
+           end do
+           flw_up(jl,j)=flw_up(jl,j) + fluxdiff(jl,1,j)
+        end do
+       end do
+
+c      downward flux
+c      ~~~~~~~~~~~~~
+       do i = 1,nlaylte+1
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefd(jl,ja,i,j) =0.
+            do l=0,j-1
+              coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_dn(jl,j) = 0.
+           do ja = 1,nuco2
+             do i=j,nlaylte
+              flw_dn(jl,j)=flw_dn(jl,j)+blay(jl,ja,i)*coefd(jl,ja,i,j) 
+             end do 
+           end do
+           flw_dn(jl,j)=flw_dn(jl,j) - fluxdiff(jl,2,j)
+        end do
+       end do
+      END IF
+
+c----------------------------------------------------------------------
+c         7.0   outputs Grads 2D
+c               ----------------
+
+c ig1d: point de la grille physique ou on veut faire la sortie
+c ig0+1:  point du decoupage de la grille physique
+
+c#ifdef undim
+      if (callg2d) then
+
+      ig1d = ngridmx/2 + 1
+c     ig1d = ngridmx
+
+      if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
+     .    .OR.  ngridmx.EQ.1   ) then
+
+          ig = ig1d-ig0
+        print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
+
+c--------------------------------------------
+c   Ouverture de g2d.dat
+c--------------------------------------------
+      if (g2d_premier) then
+        open (47,file='g2d.dat'
+clmd     &       ,form='unformatted',access='direct',recl=4)
+     &        ,form='unformatted',access='direct',recl=1
+     &        ,status='unknown')
+        g2d_irec=0
+        g2d_appel=0
+        g2d_premier=.false.
+      endif
+        g2d_appel = g2d_appel+1
+
+c--------------------------------------------
+c   Sortie g2d des xi proches + distants 
+c--------------------------------------------
+cl                               if (nflev .NE. 500) then
+      do ja = 1,nuco2
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = xi(ig1d,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+cl                               endif
+
+c------------------------------------------------------
+c   Writeg2d des ksidb 
+c------------------------------------------------------
+      do ja = 1,nuco2
+c       ja=1
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = ksidb(ig,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = ksidb(ig,3,i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d dpsgcp
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            dpsgcp(i,j) = dp(ig,j) / gcp
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+c         dpsgcp(i,0) = 0.0002  ! (rapport ~ entre 1000 et 10000 pour le sol)
+          dpsgcp(i,0) = 1.      ! (pour regler l'echelle des sorties)
+          dpsgcp(i,nlaylte+1) = 0.
+        enddo
+
+c     print*
+c     print*,'gcp: ',gcp
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dp: ',dp(ig,i)
+c       enddo
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dpsgcp: ',dpsgcp(i,1)
+c       enddo
+  
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = dpsgcp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d temperature
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            temp(i,j) = tlay(ig,j)
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+          temp(i,0) = tlev(ig,1)+dt0(ig)     ! temperature surface
+          temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
+        enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = temp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+        write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
+        write(76,*) 'nlaylte', nlaylte
+        write(76,*) 'nflev', nflev
+        write(76,*) 'kdlon', kdlon
+        write(76,*) 'ndlo2', ndlo2
+        write(76,*) 'ndlon', ndlon
+      do ja=1,4
+        write(76,*) 'bsurf', ja, bsurf(ig,ja)
+        write(76,*) 'btop', ja, btop(ig,ja)
+
+        do j=1,nlaylte+1
+          write(76,*) 'blev', ja, j, blev(ig,ja,j)
+        enddo
+
+        do j=1,nlaylte
+          write(76,*) 'blay', ja, j, blay(ig,ja,j)
+        enddo
+
+        do j=1,2*nlaylte
+          write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
+        enddo
+      enddo
+
+      endif
+c************************************************************************
+c#endif 
+      endif  !   callg2d
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwflux_SP36.old	(revision 46)
@@ -0,0 +1,506 @@
+       subroutine lwflux (kdlon,kflev,dp
+     .                   ,bsurf,btop,blev,blay,dbsublay
+     .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .                   ,emis
+     .                   , tautotal,omegtotal,gtotal
+     .                   ,coolrate,fluxground,fluxtop
+     .                   ,netrad)
+
+c----------------------------------------------------------------------
+c     LWFLUX     computes the fluxes
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon                 ! part of ngrid
+      integer kflev                 ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+
+      real bsurf (ndlo2,nir)             ! surface spectral planck function
+      real blev (ndlo2,nir,kflev+1)      ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)        ! layer   spectral planck function
+      real btop (ndlo2,nir)              ! top spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+      real emis (ndlo2)                  ! surface emissivity
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols prop.)
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)    ! radiative cooling rate (K/s) 
+      real netrad (ndlo2,kflev)     ! radiative budget (W/m2) 
+      real fluxground(ndlo2)        ! downward flux on the ground
+                                    ! for surface radiative budget
+      real fluxtop(ndlo2)           ! upward flux on the top of atm ("OLR")
+
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,j,i,ig1d,l,ndim
+      parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
+      real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
+
+      real dpsgcp (0:nflev+1,0:nflev+1)    !  dp/(g.cp)
+      real temp (0:nflev+1,0:nflev+1)       
+
+      real fluxdiff(ndlon,2,nflev+1)  ! diffusion flux: upward(1) downward(2) 
+
+      real*4 reel4
+
+c     To compute IR flux in the atmosphere  (For diagnostic only !!)
+      logical computeflux
+      real coefd(ngridmx,nuco2,nflev+1,nflev+1) 
+      real coefu(ngridmx,nuco2,0:nflev,nflev+1)
+      real flw_up(ngridmx,nflev+1), flw_dn(ngridmx,nflev+1) ! fluxes (W/m2)
+
+
+      call zerophys(ndim, ksidb)
+
+c----------------------------------------------------------------------
+c         1.1   exchanges (layer i <--> all layers up to i) 
+c               -------------------------------------------
+
+      do i = 1,nlaylte
+        do j = i+1,nlaylte
+          do ja = 1,nuco2
+            do jl = 1,kdlon
+
+      ksidb(jl,ja,i,j) = xi(jl,ja,i,j) 
+     .                 * (blay(jl,ja,j)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,j,i) = -ksidb(jl,ja,i,j)
+      
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   exchanges (ground <--> all layers) 
+c               ----------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,0) = xi(jl,ja,0,i) 
+     .                 * (bsurf(jl,ja)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,0,i) = -ksidb(jl,ja,i,0)
+
+          enddo
+        enddo
+      enddo
+
+c--------------------------------------------------------
+c  Here we add the neighbour contribution 
+c           for exchanges between ground and first layer
+c--------------------------------------------------------
+
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
+     .                 - xi_ground(jl,ja) 
+     .                 * (blev(jl,ja,1)-blay(jl,ja,1))
+
+cc                                                       ksidb reciprocity
+cc                                                       -----------------
+      ksidb(jl,ja,0,1) = - ksidb(jl,ja,1,0)
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         1.3   exchanges (layer i <--> space) 
+c               ------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,nlaylte+1) = xi(jl,ja,i,nlaylte+1) 
+     .                       * (-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,i) = - ksidb(jl,ja,i,nlaylte+1)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.4   exchanges (ground <--> space) 
+c               -----------------------------
+
+      do ja = 1,nuco2
+        do jl = 1,kdlon
+
+      ksidb(jl,ja,0,nlaylte+1) = xi(jl,ja,0,nlaylte+1) 
+     .                       * (-bsurf(jl,ja))
+
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,0) = - ksidb(jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   sum of band 1 and 2 of co2 contribution 
+c               ---------------------------------------
+
+      do i = 0,nlaylte+1
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            ksidb(jl,3,i,j)= ksidb(jl,1,i,j) + ksidb(jl,2,i,j)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         3.0   Diffusion
+c               ---------
+
+      i = nlaylte+1
+      do jl = 1,kdlon
+        fluxdiff(jl,1,i)   = 0.
+        fluxdiff(jl,2,i)   = 0.
+      enddo
+
+      call lwdiff (kdlon,kflev
+     .         ,bsurf,btop,dbsublay
+     .         ,tautotal,omegtotal,gtotal
+     .         ,emis,fluxdiff)
+
+c----------------------------------------------------------------------
+c         4.0   Radiative Budget for each layer i
+c               ---------------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+            netrad(jl,i) = 0.
+        enddo
+      enddo
+
+      do i = 1,nlaylte
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            netrad(jl,i) = netrad(jl,i) + ksidb(jl,3,i,j)
+
+          enddo
+        enddo
+      enddo
+c                                                 diffusion contribution
+c                                                 ----------------------
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          netrad(jl,i) = netrad(jl,i) 
+     .                 - fluxdiff(jl,1,i+1) - fluxdiff(jl,2,i+1)   
+     .                 + fluxdiff(jl,1,i)   + fluxdiff(jl,2,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate for each layer i
+c               -----------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          coolrate(jl,i) = gcp * netrad(jl,i) / dp(jl,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         5.0   downward flux (all layers --> ground): "fluxground" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxground(jl) = 0.
+      enddo
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      fluxground(jl) = fluxground(jl)
+     .               + xi(jl,ja,0,i) * (blay(jl,ja,i))
+
+          enddo
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxground(jl) = fluxground(jl) - fluxdiff(jl,2,1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.0   outgoing flux (all layers --> space): "fluxtop" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxtop(jl) = 0.
+      enddo
+
+      do i = 0,nlaylte
+        do jl = 1,kdlon
+           fluxtop(jl) = fluxtop(jl)- ksidb(jl,3,i,nlaylte+1)
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxtop(jl) = fluxtop(jl) + fluxdiff(jl,1,nlaylte+1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.5 ONLY FOR DIAGNOSTIC : Compute IR flux in the atmosphere 
+c             -------------------
+c     The broadband fluxes (W.m-2) at every level  from surface level (l=1) 
+c     up the top of the  upper layer (here: l=nlaylte+1) are:
+c     upward : flw_up(ig1d,l)   ;   downward : flw_dn(ig1d,j) 
+c
+      computeflux = .false.
+
+      IF (computeflux) THEN  ! not used by the GCM only for diagnostic !
+c      upward flux 
+c      ~~~~~~~~~~~
+       do i = 0,nlaylte
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefu(jl,ja,i,j) =0.
+            do l=j,nlaylte+1 
+              coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(jl,ja,l,i)
+            end do
+
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_up(jl,j) = 0.
+           do ja = 1,nuco2
+             flw_up(jl,j)=flw_up(jl,j)+bsurf(jl,ja)*coefu(jl,ja,0,j)
+             do i=1,j-1
+              flw_up(jl,j)=flw_up(jl,j)+blay(jl,ja,i)*coefu(jl,ja,i,j) 
+             end do 
+           end do
+           flw_up(jl,j)=flw_up(jl,j) + fluxdiff(jl,1,j)
+        end do
+       end do
+
+c      downward flux
+c      ~~~~~~~~~~~~~
+       do i = 1,nlaylte+1
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefd(jl,ja,i,j) =0.
+            do l=0,j-1
+              coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(jl,ja,l,i)
+            end do
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_dn(jl,j) = 0.
+           do ja = 1,nuco2
+             do i=j,nlaylte
+              flw_dn(jl,j)=flw_dn(jl,j)+blay(jl,ja,i)*coefd(jl,ja,i,j) 
+             end do 
+           end do
+           flw_dn(jl,j)=flw_dn(jl,j) - fluxdiff(jl,2,j)
+        end do
+       end do
+      END IF
+
+c----------------------------------------------------------------------
+c         7.0   outputs Grads 2D
+c               ----------------
+
+c ig1d: point de la grille physique ou on veut faire la sortie
+
+c#ifdef undim
+      if (callg2d) then
+
+      ig1d = ngridmx/2 + 1
+c     ig1d = ngridmx
+
+      print*, 'Sortie g2d: ig1d =', ig1d
+
+c--------------------------------------------
+c   Ouverture de g2d.dat
+c--------------------------------------------
+      if (g2d_premier) then
+        open (47,file='g2d.dat'
+clmd     &       ,form='unformatted',access='direct',recl=4)
+     &        ,form='unformatted',access='direct',recl=1
+     &        ,status='unknown')
+        g2d_irec=0
+        g2d_appel=0
+        g2d_premier=.false.
+      endif
+        g2d_appel = g2d_appel+1
+
+c--------------------------------------------
+c   Sortie g2d des xi proches + distants 
+c--------------------------------------------
+cl                               if (nflev .NE. 500) then
+      do ja = 1,nuco2
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = xi(ig1d,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+cl                               endif
+
+c------------------------------------------------------
+c   Writeg2d des ksidb 
+c------------------------------------------------------
+      do ja = 1,nuco2
+c       ja=1
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = ksidb(ig1d,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = ksidb(ig1d,3,i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d dpsgcp
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            dpsgcp(i,j) = dp(ig1d,j) / gcp
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+c         dpsgcp(i,0) = 0.0002  ! (rapport ~ entre 1000 et 10000 pour le sol)
+          dpsgcp(i,0) = 1.      ! (pour regler l'echelle des sorties)
+          dpsgcp(i,nlaylte+1) = 0.
+        enddo
+
+c     print*
+c     print*,'gcp: ',gcp
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dp: ',dp(ig1d,i)
+c       enddo
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dpsgcp: ',dpsgcp(i,1)
+c       enddo
+  
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = dpsgcp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d temperature
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            temp(i,j) = tlay(ig1d,j)
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+          temp(i,0) = tlev(ig1d,1)+dt0(ig1d)     ! temperature surface
+          temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
+        enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = temp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+        write(76,*) 'ig1d =', ig1d
+        write(76,*) 'nlaylte', nlaylte
+        write(76,*) 'nflev', nflev
+        write(76,*) 'kdlon', kdlon
+        write(76,*) 'ndlo2', ndlo2
+        write(76,*) 'ndlon', ndlon
+      do ja=1,4
+        write(76,*) 'bsurf', ja, bsurf(ig1d,ja)
+        write(76,*) 'btop', ja, btop(ig1d,ja)
+
+        do j=1,nlaylte+1
+          write(76,*) 'blev', ja, j, blev(ig1d,ja,j)
+        enddo
+
+        do j=1,nlaylte
+          write(76,*) 'blay', ja, j, blay(ig1d,ja,j)
+        enddo
+
+        do j=1,2*nlaylte
+          write(76,*) 'dbsublay', ja, j, dbsublay(ig1d,ja,j)
+        enddo
+      enddo
+
+c************************************************************************
+c#endif 
+      endif  !   callg2d
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi.F	(revision 46)
@@ -0,0 +1,220 @@
+      subroutine lwi (ig0,kdlon,kflev
+     .                ,psi,zdblay,pdp
+     .                ,newpcolc )
+
+
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "yomlw.h"
+ 
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Shema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c
+ 
+      integer ig0,kdlon,kflev
+
+      real    psi(ndlo2,kflev)
+     .     ,  zdblay(ndlo2,nir,kflev)
+     .     ,  pdp(ndlo2,kflev)
+
+
+      real    newpcolc(ndlo2,kflev)
+
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(ndlon,nflev) 
+     .      , hi(ndlon,nflev) 
+     .      , bi(ndlon,nflev) 
+
+      real    ci(ndlon,nflev) 
+     .      , ai(ndlon,nflev) 
+      real    deltat
+
+      real   semit, denom
+
+      integer i, jl
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+ 
+        deltat = dtphys * iradia
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+        semit = semi * deltat
+c       semi = 0.
+
+c       print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit
+c       print*,'g,cpp',g,cpp
+
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
+     .    ( xi(ig0+jl,1,i,nlaylte+1)
+     .    + xi(ig0+jl,1,i,i+1)
+     .    + xi(ig0+jl,1,i,i-1) )
+     .    *    zdblay(jl,1,i)
+     .  + ( xi(ig0+jl,2,i,nlaylte+1)
+     .    + xi(ig0+jl,2,i,i+1)
+     .    + xi(ig0+jl,2,i,i-1) )
+     .    *    zdblay(jl,2,i)
+     .     )
+c     -------------------
+        enddo
+      enddo
+
+c couche nlaylte
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+
+      do jl = 1 , kdlon
+c     -------------------
+      di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
+     .    ( xi(ig0+jl,1,nlaylte,nlaylte+1)
+     .    + xi(ig0+jl,1,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,1,nlaylte)
+     .  + ( xi(ig0+jl,2,nlaylte,nlaylte+1)
+     .    + xi(ig0+jl,2,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,2,nlaylte)
+     .     )
+c     -------------------
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
+     .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)   
+     .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+c     -------------------
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+c     -------------------
+      bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
+     .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)   
+     .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+c     -------------------
+        enddo
+      enddo
+
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+
+      do jl = 1 , kdlon
+        bi(jl,1) = 0 
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nlaylte
+c ------------
+
+      do jl = 1 , kdlon
+c     -------------------
+      ci(jl,nlaylte) = (gcp * psi(jl,nlaylte) / pdp(jl,nlaylte))
+     .                   / di(jl,nlaylte)
+
+      ai(jl,nlaylte) = - bi(jl,nlaylte) / di(jl,nlaylte)
+c     -------------------
+      enddo
+
+
+
+      do i = nlaylte-1 , 1 , -1
+        do jl = 1 , kdlon
+c     -------------------
+      denom = di(jl,i) + hi(jl,i) * ai(jl,i+1)
+
+      ci(jl,i) = (  gcp * psi(jl,i) / pdp(jl,i)
+     .             - hi(jl,i) * ci(jl,i+1)  )  / denom
+ 
+      ai(jl,i) = -bi(jl,i) / denom
+c     -------------------
+        enddo
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+c couche 1
+c -------
+      do jl = 1 , kdlon
+        newpcolc(jl,1) = ci(jl,1)
+      enddo
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+           newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1)
+        enddo
+      enddo
+
+
+
+c-------------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwi_SP36.old	(revision 46)
@@ -0,0 +1,223 @@
+      subroutine lwi (kdlon,kflev
+     .                ,psi,zdblay,pdp
+     .                ,newpcolc )
+
+
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "yomlw.h"
+ 
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Shema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c
+ 
+      integer kdlon,kflev
+
+      real    psi(ndlo2,kflev)
+     .     ,  zdblay(ndlo2,nir,kflev)
+     .     ,  pdp(ndlo2,kflev)
+
+
+      real    newpcolc(ndlo2,kflev)
+
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(ndlon,nflev) 
+     .      , hi(ndlon,nflev) 
+     .      , bi(ndlon,nflev) 
+
+      real    ci(ndlon,nflev) 
+     .      , ai(ndlon,nflev) 
+      real    deltat
+
+      real   semit, denom
+
+      integer i, jl
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+ 
+        deltat = dtphys * iradia
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+        semit = semi * deltat
+c       semi = 0.
+
+c       print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit
+c       print*,'g,cpp',g,cpp
+
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
+     .    ( xi(jl,1,i,nlaylte+1) 
+     .    + xi(jl,1,i,i+1) 
+     .    + xi(jl,1,i,i-1) )
+     .    *    zdblay(jl,1,i) 
+     .  + ( xi(jl,2,i,nlaylte+1) 
+     .    + xi(jl,2,i,i+1) 
+     .    + xi(jl,2,i,i-1) )
+     .    *    zdblay(jl,2,i) 
+     .     )
+c     -------------------
+        enddo
+      enddo
+
+
+
+c couche nlaylte
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+
+      do jl = 1 , kdlon
+c     -------------------
+      di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
+     .    ( xi(jl,1,nlaylte,nlaylte+1) 
+     .    + xi(jl,1,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,1,nlaylte) 
+     .  + ( xi(jl,2,nlaylte,nlaylte+1) 
+     .    + xi(jl,2,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,2,nlaylte) 
+     .     )
+c     -------------------
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
+     .            (    xi(jl,1,i,i+1) * zdblay(jl,1,i+1)
+     .               + xi(jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+c     -------------------
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+c     -------------------
+      bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
+     .           (     xi(jl,1,i,i-1) * zdblay(jl,1,i-1)
+     .               + xi(jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+c     -------------------
+        enddo
+      enddo
+
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+
+      do jl = 1 , kdlon
+        bi(jl,1) = 0 
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nlaylte
+c ------------
+
+      do jl = 1 , kdlon
+c     -------------------
+      ci(jl,nlaylte) = (gcp * psi(jl,nlaylte) / pdp(jl,nlaylte))
+     .                   / di(jl,nlaylte)
+
+      ai(jl,nlaylte) = - bi(jl,nlaylte) / di(jl,nlaylte)
+c     -------------------
+      enddo
+
+
+
+      do i = nlaylte-1 , 1 , -1
+        do jl = 1 , kdlon
+c     -------------------
+      denom = di(jl,i) + hi(jl,i) * ai(jl,i+1)
+
+      ci(jl,i) = (  gcp * psi(jl,i) / pdp(jl,i)
+     .             - hi(jl,i) * ci(jl,i+1)  )  / denom
+ 
+      ai(jl,i) = -bi(jl,i) / denom
+c     -------------------
+        enddo
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+c couche 1
+c -------
+      do jl = 1 , kdlon
+        newpcolc(jl,1) = ci(jl,1)
+      enddo
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+           newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1)
+        enddo
+      enddo
+
+
+
+c-------------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain.F	(revision 46)
@@ -0,0 +1,206 @@
+       subroutine lwmain (ig0,icount,kdlon,kflev
+     .                   ,dp,dt0,emis
+     .                   ,plev,tlev,tlay,aerosol,coolrate
+     .                   ,fluxground,fluxtop
+     .                   ,netrad
+     &                   ,QIRsQREF3d,omegaIR3d,gIR3d)
+
+c----------------------------------------------------------------------
+c     LWMAIN     organizes the LTE longwave calculations
+c     for layer 1 to layer "nlaylte" (stored in  "yomlw.h")
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer icount
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real dt0 (ndlo2)              ! surface temperature discontinuity (K)
+      real emis (ndlo2)             ! surface emissivity
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlev (ndlo2,kflev+1)     ! level temperature (K)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol(ndlo2,kflev,naerkind)      !  aerosol extinction optical
+c                         depth at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)      ! cooling rate (K/s)
+      real fluxground(ndlo2)          ! downward ground flux (W/m2)
+      real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
+      real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
+c     Aerosol optical properties
+      REAL :: QIRsQREF3d(ndlo2,kflev,nir,naerkind)
+      REAL :: omegaIR3d(ndlo2,kflev,nir,naerkind)
+      REAL :: gIR3d(ndlo2,kflev,nir,naerkind)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      real aer_t (ndlon,nuco2,nflev+1)  ! transmission (aer)
+      real co2_u (ndlon,nuco2,nflev+1)  ! absorber amounts (co2)
+      real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2)
+
+      real bsurf (ndlon,nir)            ! surface spectral planck function
+      real btop (ndlon,nir)             ! top spectral planck function
+      real blev (ndlon,nir,nflev+1)     ! level   spectral planck function
+      real blay (ndlon,nir,nflev)       ! layer   spectral planck function
+      real dblay (ndlon,nir,nflev)      ! layer gradient spectral planck function
+      real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck function
+                                        ! in sub layers
+
+      real tautotal(ndlon,nflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlon,nflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlon,nflev,nir)    ! /   NAERKIND aerosols prop.)
+
+      real newcoolrate(ndlon,nflev) ! cooling rate (K/s) / with implicite scheme
+
+      integer jk,jkk,ja,jl
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      if (firstcall) then
+
+        firstcall = .false.
+
+        do jkk = 0 , nlaylte+1
+          do jk = 0 , nlaylte+1
+            do ja = 1 , nuco2
+              do jl = 1 , ngridmx
+                  xi (jl,ja,jk,jkk)=0.
+              enddo
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+c         1.0   planck function
+c               ---------------
+
+      call lwb ( kdlon, kflev, tlev, tlay, dt0
+     .         , bsurf, btop, blay, blev, dblay, dbsublay)
+
+c----------------------------------------------------------------------
+c         2.0   absorber amounts
+c               ----------------
+
+      call lwu ( kdlon, kflev
+     .         , dp, plev, tlay, aerosol
+     &         , QIRsQREF3d,omegaIR3d,gIR3d
+     .         , aer_t, co2_u, co2_up
+     .         , tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c         3.0   transmission functions / exchange coefficiants
+c               ----------------------------------------------
+
+c                                                                distants
+c                                                                --------
+                    if( mod(icount-1,ilwd).eq.0) then
+
+c     print*, 'CALL of DISTANTS'
+      call lwxd ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              neighbours
+c                                                              ----------
+                    if( mod(icount-1,ilwn).eq.0) then
+
+c     print*, 'CALL of NEIGHBOURS'
+      call lwxn ( ig0, kdlon, kflev
+     .          , dp
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              boundaries
+c                                                              ----------
+                    if( mod(icount-1,ilwb).eq.0) then
+
+c     print*, 'CALL of BOUNDARIES'
+      call lwxb ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate
+c               ------------
+
+      call lwflux ( ig0, kdlon, kflev, dp
+     .            , bsurf, btop, blev, blay, dbsublay
+     .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .            , emis
+     .            , tautotal,omegtotal,gtotal
+     .            , coolrate, fluxground, fluxtop
+     .            , netrad)
+
+c     do jk = 1, nlaylte
+c       print*,coolrate(1,jk)
+c     enddo
+      
+c       do jkk = 0 , nlaylte+1
+c         do jk = 0 , nlaylte+1
+c           do ja = 1 , nuco2
+c             do jl = 1 , ngridmx
+c      if (xi (jl,ja,jk,jkk) .LT. 0
+c    .       .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then
+c                 print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk)
+c      endif
+c             enddo
+c           enddo
+c         enddo
+c       enddo
+
+c----------------------------------------------------------------------
+c
+c          5.    shema semi-implicite  (lwi) 
+c                ---------------------------
+c
+c
+      call lwi (ig0,kdlon,kflev,netrad,dblay,dp
+     .          , newcoolrate)
+c
+c  Verif que   (X sol,space) + somme(X i,sol) = 1
+c
+      do jkk = 1 , nlaylte
+        do jl = 1 , kdlon
+c     print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk) 
+c    .  ,coolrate(jl,jkk)
+      coolrate(jl,jkk) = newcoolrate(jl,jkk)
+        enddo
+      enddo
+c
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwmain_SP36.old	(revision 46)
@@ -0,0 +1,205 @@
+       subroutine lwmain (icount,kdlon,kflev
+     .                   ,dp,dt0,emis
+     .                   ,plev,tlev,tlay,aerosol,coolrate
+     .                   ,fluxground,fluxtop
+     .                   ,netrad
+     &                   ,QIRsQREF3d,omegaIR3d,gIR3d)
+
+c----------------------------------------------------------------------
+c     LWMAIN     organizes the LTE longwave calculations
+c     for layer 1 to layer "nlaylte" (stored in  "yomlw.h")
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer icount
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real dt0 (ndlo2)              ! surface temperature discontinuity (K)
+      real emis (ndlo2)             ! surface emissivity
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlev (ndlo2,kflev+1)     ! level temperature (K)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol(ndlo2,kflev,naerkind)      !  aerosol extinction optical
+c                         depth at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)      ! cooling rate (K/s)
+      real fluxground(ndlo2)          ! downward ground flux (W/m2)
+      real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
+      real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
+c     Aerosol optical properties
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      real aer_t (ndlon,nuco2,nflev+1)  ! transmission (aer)
+      real co2_u (ndlon,nuco2,nflev+1)  ! absorber amounts (co2)
+      real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2)
+
+      real bsurf (ndlon,nir)            ! surface spectral planck function
+      real btop (ndlon,nir)             ! top spectral planck function
+      real blev (ndlon,nir,nflev+1)     ! level   spectral planck function
+      real blay (ndlon,nir,nflev)       ! layer   spectral planck function
+      real dblay (ndlon,nir,nflev)      ! layer gradient spectral planck function
+      real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck function
+                                        ! in sub layers
+
+      real tautotal(ndlon,nflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlon,nflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlon,nflev,nir)    ! /   NAERKIND aerosols prop.)
+
+      real newcoolrate(ndlon,nflev) ! cooling rate (K/s) / with implicite scheme
+
+      integer jk,jkk,ja,jl
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      if (firstcall) then
+
+        firstcall = .false.
+
+        do jkk = 0 , nlaylte+1
+          do jk = 0 , nlaylte+1
+            do ja = 1 , nuco2
+              do jl = 1 , ngridmx
+                  xi (jl,ja,jk,jkk)=0.
+              enddo
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+c         1.0   planck function
+c               ---------------
+
+      call lwb ( kdlon, kflev, tlev, tlay, dt0
+     .         , bsurf, btop, blay, blev, dblay, dbsublay)
+
+c----------------------------------------------------------------------
+c         2.0   absorber amounts
+c               ----------------
+
+      call lwu ( kdlon, kflev
+     .         , dp, plev, tlay, aerosol
+     &         , QIRsQREF3d,omegaIR3d,gIR3d
+     .         , aer_t, co2_u, co2_up
+     .         , tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c         3.0   transmission functions / exchange coefficiants
+c               ----------------------------------------------
+
+c                                                                distants
+c                                                                --------
+                    if( mod(icount-1,ilwd).eq.0) then
+
+c     print*, 'CALL of DISTANTS'
+      call lwxd ( kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              neighbours
+c                                                              ----------
+                    if( mod(icount-1,ilwn).eq.0) then
+
+c     print*, 'CALL of NEIGHBOURS'
+      call lwxn ( kdlon, kflev
+     .          , dp
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              boundaries
+c                                                              ----------
+                    if( mod(icount-1,ilwb).eq.0) then
+
+c     print*, 'CALL of BOUNDARIES'
+      call lwxb ( kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate
+c               ------------
+
+      call lwflux ( kdlon, kflev, dp
+     .            , bsurf, btop, blev, blay, dbsublay
+     .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .            , emis
+     .            , tautotal,omegtotal,gtotal
+     .            , coolrate, fluxground, fluxtop
+     .            , netrad)
+
+c     do jk = 1, nlaylte
+c       print*,coolrate(1,jk)
+c     enddo
+      
+c       do jkk = 0 , nlaylte+1
+c         do jk = 0 , nlaylte+1
+c           do ja = 1 , nuco2
+c             do jl = 1 , ngridmx
+c      if (xi (jl,ja,jk,jkk) .LT. 0
+c    .       .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then
+c                 print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk)
+c      endif
+c             enddo
+c           enddo
+c         enddo
+c       enddo
+
+c----------------------------------------------------------------------
+c
+c          5.    shema semi-implicite  (lwi) 
+c                ---------------------------
+c
+c
+      call lwi (kdlon,kflev,netrad,dblay,dp
+     .          , newcoolrate)
+c
+c  Verif que   (X sol,space) + somme(X i,sol) = 1
+c
+      do jkk = 1 , nlaylte
+        do jl = 1 , kdlon
+c     print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk) 
+c    .  ,coolrate(jl,jkk)
+      coolrate(jl,jkk) = newcoolrate(jl,jkk)
+        enddo
+      enddo
+c
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwtt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwtt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwtt.F	(revision 46)
@@ -0,0 +1,65 @@
+      subroutine lwtt (kdlon,u,up,nu,tr)
+
+c----------------------------------------------------------------------
+c     LWTT   computes the longwave transmission functions
+c            for all the absorbers in all spectral intervals
+c            using pade approximants and horner's algorithm
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer nu               ! 
+
+      real    u (ndlo2,nu)     ! absorber amounts 
+      real    up (ndlo2,nu)    ! idem scaled by the pressure
+
+c                                                            outputs:
+c                                                            --------
+      real    tr (ndlo2,nu)    ! transmission functions
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl
+
+      real xn (ndlon)
+      real xd (ndlon)
+      real ueq (ndlon)
+
+c----------------------------------------------------------------------
+c   Transmission by the CO2 15 microns band:
+c   ----------------------------------------
+
+      do  ja=1,nu
+	    do jl=1,kdlon
+c                              equivalent absorber amount (Doppler effect)
+c                             --------------------------------------------
+	      ueq(jl) = sqrt(up(jl,ja))
+     .              +cst_voigt(1,ja)*u(jl,ja)**cst_voigt(2,ja)
+
+c                                                      Horner's algorithm
+c                                                      ------------------
+            xn(jl) = ga(1,ja) + 
+     .      ueq(jl)*(ga(2,ja) + ueq(jl) * ga(3,ja) )
+            xd(jl) = gb(1,ja) + ueq(jl)*(gb(2,ja) + 
+     .      ueq(jl) * ( gb(3,ja) + ueq(jl)  ))
+            tr(jl,ja) = xn(jl) / xd(jl)
+
+	    enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwu.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwu.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwu.F	(revision 46)
@@ -0,0 +1,209 @@
+      subroutine lwu (kdlon,kflev
+     &                ,dp,plev,tlay,aerosol 
+     &                ,QIRsQREF3d,omegaIR3d,gIR3d
+     &                ,aer_t,co2_u,co2_up
+     &                ,tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c     LWU   computes  - co2: longwave effective absorber amounts including 
+c                      pressure and temperature effects 
+c                     - aerosols: amounts for every band
+c                                transmission for bandes 1 and 2 of co2
+c----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+c! modif diffusion
+c! on ne change rien a la bande CO2 : les quantites d'absorbant CO2
+c! sont multipliees par 1.66
+c! pview= 1/cos(teta0)=1.66
+c
+c Modif J.-B. Madeleine: Computing optical properties of dust and
+c   water-ice crystals in each gridbox. Optical parameters of
+c   water-ice clouds are convolved to crystal sizes predicted by
+c   the microphysical scheme.
+c-----------------------------------------------------------------------
+ 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------                                    
+c                                                            inputs:
+c                                                            -------
+      integer kdlon        ! part of ngrid
+      integer kflev        ! part of nalyer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol (ndlo2,kflev,naerkind) ! aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+      REAL QIRsQREF3d(ndlo2,kflev,nir,naerkind)  ! 3d ext. coef.
+      REAL omegaIR3d(ndlo2,kflev,nir,naerkind)   ! 3d ssa
+      REAL gIR3d(ndlo2,kflev,nir,naerkind)       ! 3d assym. param.
+
+c                                                            outputs:
+c                                                            --------
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer) 
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols properties)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jl,jk,jkl,ja,n
+ 
+      real aer_u (ndlon,nir,nflev+1)     ! absorber amounts (aer) extinction
+      real co2c           ! co2 concentration (pa/pa)
+      real pview          ! cosecant of viewing angle
+      real pref           ! reference pressure (1013 mb = 101325 Pa)
+      real tx,tx2
+      real phi (ndlon,nuco2)
+      real psi (ndlon,nuco2)
+      real plev2 (ndlon,nflev+1)
+      real zzz
+
+      real ray,coefsize,coefsizew,coefsizeg 
+
+c************************************************************************
+c----------------------------------------------------------------------
+c         0.3  Initialisation  
+c               -------------
+
+      pview = 1.66
+      co2c = 0.95           
+      pref = 101325.
+
+      do jk=1,nlaylte+1
+        do jl=1,kdlon
+          plev2(jl,jk)=plev(jl,jk)*plev(jl,jk)
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c  Computing TOTAL single scattering parameters by adding properties of
+c  all the NAERKIND kind of aerosols in each IR band
+
+      call zerophys(ndlon*kflev*nir,tautotal)
+      call zerophys(ndlon*kflev*nir,omegtotal)
+      call zerophys(ndlon*kflev*nir,gtotal)
+
+      do n=1,naerkind
+        do ja=1,nir
+          do jk=1,nlaylte
+            do jl = 1,kdlon
+              tautotal(jl,jk,ja)=tautotal(jl,jk,ja) +
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)
+              omegtotal(jl,jk,ja) =  omegtotal(jl,jk,ja) + 
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+     &           omegaIR3d(jl,jk,ja,n)
+              gtotal(jl,jk,ja) =  gtotal(jl,jk,ja) + 
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+     &           omegaIR3d(jl,jk,ja,n)*gIR3d(jl,jk,ja,n)
+            enddo
+          enddo
+        enddo
+      enddo
+      do ja=1,nir
+        do jk=1,nlaylte
+          do jl = 1,kdlon
+             gtotal(jl,jk,ja)=gtotal(jl,jk,ja)/omegtotal(jl,jk,ja)
+             omegtotal(jl,jk,ja)=omegtotal(jl,jk,ja)/tautotal(jl,jk,ja)
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.0   cumulative (aerosol) amounts (for every band)
+c               ----------------------------
+
+      jk=nlaylte+1
+      do ja=1,nir
+        do jl = 1 , kdlon
+          aer_u(jl,ja,jk)=0.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+        jkl=nlaylte+1-jk
+        do ja=1,nir
+          do jl=1,kdlon
+             aer_u(jl,ja,jkl)=aer_u(jl,ja,jkl+1)+ tautotal(jl,jkl,ja)
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+c         1.0   bands 1 and 2 of co2
+c               --------------------
+
+      jk=nlaylte+1
+      do ja=1,nuco2
+        do jl = 1 , kdlon
+          co2_u(jl,ja,jk)=0.
+          co2_up(jl,ja,jk)=0.
+          aer_t(jl,ja,jk)=1.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+                       jkl=nlaylte+1-jk
+        do ja=1,nuco2
+          do jl=1,kdlon
+
+c                 introduces temperature effects on absorber(co2) amounts
+c                 -------------------------------------------------------
+            tx = sign(min(abs(tlay(jl,jkl)-tref),70.)
+     .         ,tlay(jl,jkl)-tref)
+            tx2=tx*tx
+            phi(jl,ja)=at(1,ja)*tx+bt(1,ja)*tx2
+            psi(jl,ja)=at(2,ja)*tx+bt(2,ja)*tx2
+            phi(jl,ja)=exp(phi(jl,ja)/cst_voigt(2,ja))
+            psi(jl,ja)=exp(2.*psi(jl,ja))
+
+c                                        cumulative absorber(co2) amounts
+c                                        --------------------------------
+            co2_u(jl,ja,jkl)=co2_u(jl,ja,jkl+1)
+     .     +         pview/(10*g)*phi(jl,ja)*dp(jl,jkl)*co2c
+
+            co2_up(jl,ja,jkl)=co2_up(jl,ja,jkl+1)
+     .     +         pview/(10*g*2*pref)*psi(jl,ja)
+     .     *        (plev2(jl,jkl)-plev2(jl,jkl+1))*co2c
+
+
+c                                                  (aerosol) transmission
+c                                                  ----------------------
+c   on calcule directement les transmissions pour les aerosols.
+c   on multiplie le Qext  par 1-omega dans la bande du CO2.
+c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr
+
+           zzz=pview*(1.-omegtotal(jl,jkl,ja))
+           aer_t(jl,ja,jkl)=exp(-zzz*aer_u(jl,ja,jkl))
+          
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb.F	(revision 46)
@@ -0,0 +1,220 @@
+      subroutine lwxb (ig0,kdlon,kflev
+     .                ,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXB   computes transmission function and exchange coefficients
+c                          for boundaries 
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c 
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |***|***|***|***|***|***|***| 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |***|   |   |   |   |   | 0 |***|
+c              |---|---|---|---|---|---|---|---|
+c     ...      |***|   |   |   |   | 0 |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      4       |***|   |   |   | 0 |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      3       |***|   |   | 0 |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      2       |***|   | 0 |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      1       |***| 0 |   |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |***|***|***|***|***|***|***|  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1
+c             (ground)                    (space)
+c
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon          ! part of ngrid
+      integer kflev          ! part of nalyer
+
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,ig0
+
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+c                                          2 for ground(1) and space(2)
+      real trans (ndlon,nuco2,2,0:nflev+1)
+      real ksi (ndlon,nuco2,2,0:nflev+1)
+c                                                       only for space
+      real trans_emis (ndlon,nuco2,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1)
+
+c*************************************************************************
+c         1.0   Transmissions 
+c               -------------
+c----------------------------------------------------------------------
+c         1.1   Direct Transmission 
+c               -------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja)  = co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+c                                                                 ground
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja) =  co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+            zu(jl,ja) =   2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) =  2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) 
+     .                    * aer_t(jl,ja,1)
+     .                    / aer_t(jl,ja,jk)
+
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c*************************************************************************
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c-------------------------------------------------------------------------
+c        2.1    colling to space  (from layer 1,nlaylte toward "layer" nlaylte+1)
+c               ----------------
+
+
+      ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
+     .                - trans(jl,ja,2,jk)
+
+      ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
+     .                   - trans_emis(jl,ja,jk+1) 
+
+      xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+     .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
+
+c-------------------------------------------------------------------------
+c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
+c               -------------------
+
+
+      ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
+     .                - trans(jl,ja,1,jk+1)
+
+      xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
+
+c-------------------------------------------------------------------------
+          enddo
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c       2.3     echange ground-space  (from "layer" 0 toward "layer" nlaylte+1)
+c               ----------------------
+
+c Is not used because we use sigma T4 for the ground budget in physiq.F
+
+      do ja = 1 , nuco2
+        do jl = 1 , kdlon
+
+      ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
+      xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxb_SP36.old	(revision 46)
@@ -0,0 +1,220 @@
+      subroutine lwxb (kdlon,kflev
+     .                ,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXB   computes transmission function and exchange coefficients
+c                          for boundaries 
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c 
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |***|***|***|***|***|***|***| 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |***|   |   |   |   |   | 0 |***|
+c              |---|---|---|---|---|---|---|---|
+c     ...      |***|   |   |   |   | 0 |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      4       |***|   |   |   | 0 |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      3       |***|   |   | 0 |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      2       |***|   | 0 |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      1       |***| 0 |   |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |***|***|***|***|***|***|***|  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1
+c             (ground)                    (space)
+c
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon          ! part of ngrid
+      integer kflev          ! part of nalyer
+
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk
+
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+c                                          2 for ground(1) and space(2)
+      real trans (ndlon,nuco2,2,0:nflev+1)
+      real ksi (ndlon,nuco2,2,0:nflev+1)
+c                                                       only for space
+      real trans_emis (ndlon,nuco2,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1)
+
+c*************************************************************************
+c         1.0   Transmissions 
+c               -------------
+c----------------------------------------------------------------------
+c         1.1   Direct Transmission 
+c               -------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja)  = co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+c                                                                 ground
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja) =  co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+            zu(jl,ja) =   2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) =  2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) 
+     .                    * aer_t(jl,ja,1)
+     .                    / aer_t(jl,ja,jk)
+
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c*************************************************************************
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c-------------------------------------------------------------------------
+c        2.1    colling to space  (from layer 1,nlaylte toward "layer" nlaylte+1)
+c               ----------------
+
+
+      ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
+     .                - trans(jl,ja,2,jk)
+
+      ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
+     .                   - trans_emis(jl,ja,jk+1) 
+
+      xi(jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+     .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(jl,ja,nlaylte+1,jk)      = xi(jl,ja,jk,nlaylte+1)
+
+c-------------------------------------------------------------------------
+c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
+c               -------------------
+
+
+      ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
+     .                - trans(jl,ja,1,jk+1)
+
+      xi(jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(jl,ja,jk,0) = xi(jl,ja,0,jk)
+
+c-------------------------------------------------------------------------
+          enddo
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c       2.3     echange ground-space  (from "layer" 0 toward "layer" nlaylte+1)
+c               ----------------------
+
+c Is not used because we use sigma T4 for the ground budget in physiq.F
+
+      do ja = 1 , nuco2
+        do jl = 1 , kdlon
+
+      ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
+      xi(jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(jl,ja,nlaylte+1,0) = xi(jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd.F	(revision 46)
@@ -0,0 +1,257 @@
+      subroutine lwxd (ig0,kdlon,kflev,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXD   computes transmission function and exchange coefficiants
+c                        for distant layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |***|***|***|***|   | 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |***|***|***|   | 0 |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |***|***|   | 0 |   |***|   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |***|   | 0 |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |   | 0 |   |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |   |   |***|***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |***|***|***|***|   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon      ! part of ngrid
+      integer kflev      ! part of nalyer
+ 
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,jkk,ndim
+      parameter(ndim = ndlon*nuco2*(nflev+2)*(nflev+2))
+
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real ksi (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+
+c----------------------------------------------------------------------
+      call zerophys(ndim,ksi_emis)
+c----------------------------------------------------------------------
+c         1.0   Transmission functions
+c               ----------------------
+
+c----------------------------------------------------------------------
+c        1.1   Direct transmission 
+c              -------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jkk)
+              zup(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+              zt_aer(jl,ja)= aer_t(jl,ja,jk)
+     .                      /aer_t(jl,ja,jkk)
+
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jk,jkk) = zt_co2(jl,ja) * zt_aer(jl,ja)
+            enddo
+          enddo
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jkk,jk) = trans(jl,ja,jk,jkk) 
+c           if (trans(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+c           if (trans(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           trans(jl,ja,jk,jkk)=1
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+
+            enddo
+          enddo
+     
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+      if (callemis) then
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja)  = 2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+     .                                         - co2_u(jl,ja,jkk)
+              zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+     .                                         - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+                zt_aer(jl,ja)  = aer_t(jl,ja,1)
+     .                         * aer_t(jl,ja,1)
+     .                         / aer_t(jl,ja,jk)
+     .                         / aer_t(jl,ja,jkk)
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = zt_co2(jl,ja)
+     .                                 * zt_aer(jl,ja)
+            enddo
+          enddo
+
+      else
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = 1.
+            enddo
+          enddo
+
+      endif
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jkk,jk) = trans_emis(jl,ja,jk,jkk)
+c         if (trans_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  trans_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'trans_emis bande',ja,jk,jkk,trans_emis(jl,ja,jk,jkk)
+c         endif
+            enddo
+          enddo
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte-2
+        do jkk = jk+2 , nlaylte
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk,jkk) = 
+     .            trans(jl,ja,jk+1,jkk)   - trans(jl,ja,jk,jkk)
+     .          - trans(jl,ja,jk+1,jkk+1) + trans(jl,ja,jk,jkk+1)
+
+      ksi_emis(jl,ja,jk,jkk) = 
+     .   trans_emis(jl,ja,jk,jkk)   - trans_emis(jl,ja,jk+1,jkk)
+     . - trans_emis(jl,ja,jk,jkk+1) + trans_emis(jl,ja,jk+1,jkk+1)
+
+c       if (ksi(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=0
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+c       if (ksi(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=1
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+
+c       if (ksi_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  ksi_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
+c       endif
+
+      xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+     .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+      ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
+      ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
+      xi(ig0+jl,ja,jkk,jk)   = xi(ig0+jl,ja,jk,jkk)
+
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.1   Save xi_emis for neighbours (lwxn.F)
+c               -----------------------------------
+
+      do jk = 1 , nlaylte-1
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c     ksi_emis(jl,ja,jk,jk+1) = 
+c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
+c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
+
+      xi_emis(ig0+jl,ja,jk) =
+     .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxd_SP36.old	(revision 46)
@@ -0,0 +1,256 @@
+      subroutine lwxd (kdlon,kflev,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXD   computes transmission function and exchange coefficiants
+c                        for distant layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |***|***|***|***|   | 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |***|***|***|   | 0 |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |***|***|   | 0 |   |***|   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |***|   | 0 |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |   | 0 |   |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |   |   |***|***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |***|***|***|***|   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon      ! part of ngrid
+      integer kflev      ! part of nalyer
+ 
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,jkk,ndim
+      parameter(ndim = ndlon*nuco2*(nflev+2)*(nflev+2))
+
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real ksi (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+
+c----------------------------------------------------------------------
+      call zerophys(ndim,ksi_emis)
+c----------------------------------------------------------------------
+c         1.0   Transmission functions
+c               ----------------------
+
+c----------------------------------------------------------------------
+c        1.1   Direct transmission 
+c              -------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jkk)
+              zup(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+              zt_aer(jl,ja)= aer_t(jl,ja,jk)
+     .                      /aer_t(jl,ja,jkk)
+
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jk,jkk) = zt_co2(jl,ja) * zt_aer(jl,ja)
+            enddo
+          enddo
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jkk,jk) = trans(jl,ja,jk,jkk) 
+c           if (trans(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+c           if (trans(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           trans(jl,ja,jk,jkk)=1
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+
+            enddo
+          enddo
+     
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+      if (callemis) then
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja)  = 2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+     .                                         - co2_u(jl,ja,jkk)
+              zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+     .                                         - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+                zt_aer(jl,ja)  = aer_t(jl,ja,1)
+     .                         * aer_t(jl,ja,1)
+     .                         / aer_t(jl,ja,jk)
+     .                         / aer_t(jl,ja,jkk)
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = zt_co2(jl,ja)
+     .                                 * zt_aer(jl,ja)
+            enddo
+          enddo
+
+      else
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = 1.
+            enddo
+          enddo
+
+      endif
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jkk,jk) = trans_emis(jl,ja,jk,jkk)
+c         if (trans_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  trans_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'trans_emis bande',ja,jk,jkk,trans_emis(jl,ja,jk,jkk)
+c         endif
+            enddo
+          enddo
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte-2
+        do jkk = jk+2 , nlaylte
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk,jkk) = 
+     .            trans(jl,ja,jk+1,jkk)   - trans(jl,ja,jk,jkk)
+     .          - trans(jl,ja,jk+1,jkk+1) + trans(jl,ja,jk,jkk+1)
+
+      ksi_emis(jl,ja,jk,jkk) = 
+     .   trans_emis(jl,ja,jk,jkk)   - trans_emis(jl,ja,jk+1,jkk)
+     . - trans_emis(jl,ja,jk,jkk+1) + trans_emis(jl,ja,jk+1,jkk+1)
+
+c       if (ksi(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=0
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+c       if (ksi(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=1
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+
+c       if (ksi_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  ksi_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
+c       endif
+
+      xi(jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+     .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+      ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
+      ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
+      xi(jl,ja,jkk,jk)   = xi(jl,ja,jk,jkk)
+
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.1   Save xi_emis for neighbours (lwxn.F)
+c               -----------------------------------
+
+      do jk = 1 , nlaylte-1
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c     ksi_emis(jl,ja,jk,jk+1) = 
+c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
+c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
+
+      xi_emis(jl,ja,jk) =
+     .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn.F	(revision 46)
@@ -0,0 +1,389 @@
+      subroutine lwxn ( ig0,kdlon,kflev
+     .                , dp
+     .                , aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXN   computes transmission function and exchange coefficiants
+c                        for neighbours layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |   |   |   |   |***| 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |   |   |   |***| 0 |***|   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |   |   |***| 0 |***|   |   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |   |***| 0 |***|   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |***| 0 |***|   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |***|   |   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |   |   |   |   |   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+c                                                                       
+c  *********************************************************** nj=1
+c
+c
+c                                       sublayer    1                  
+c
+c
+c                                ----------------------------- nj=2
+c
+c                                       sublayer    2                  
+c
+c    - - - -  LAYER j - - - - -  ----------------------------- nj=3
+c
+c                                       sublayer    3                  
+c                                ----------------------------- nj=4
+c                                       sublayer  ncouche                  
+c  *********************************************************** ni=nj=ncouche+1
+c                                       sublayer  ncouche                  
+c                                ----------------------------- ni=4
+c                                       sublayer    3                  
+c
+c    - - - -  LAYER i - - - - -  ----------------------------- ni=3
+c
+c                                       sublayer    2                  
+c                     
+c                                ----------------------------- ni=2
+c
+c
+c                                       sublayer    1                  
+c
+c
+c  *********************************************************** ni=1
+c                                                                       
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon     ! part of ngrid
+      integer kflev     ! part of nalyer
+
+      real dp (ndlo2,kflev)              ! layer pressure thickness (Pa)
+
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,nlmd,ni,nj
+
+      integer nmax
+      parameter (nmax=50)               ! max: 50 sublayers
+
+      real cn (nmax), cb (nmax)
+
+      real zu_layer_i (ndlon,nuco2)
+      real zup_layer_i (ndlon,nuco2)
+      real zt_aer_layer_i (ndlon,nuco2)
+
+      real zu_layer_j (ndlon,nuco2)
+      real zup_layer_j (ndlon,nuco2)
+      real zt_aer_layer_j (ndlon,nuco2)
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real zu_i (ndlon,nuco2,nmax+1)
+      real zup_i (ndlon,nuco2,nmax+1)
+      real zu_j (ndlon,nuco2,nmax+1)
+      real zup_j (ndlon,nuco2,nmax+1)
+      real zt_aer_i (ndlon,nuco2,nmax+1)
+      real zt_aer_j (ndlon,nuco2,nmax+1)
+
+      real trans (ndlon,nuco2,nmax+1,nmax+1)
+      real ksi (ndlon,nuco2,nflev-1)
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      jk=ncouche+1
+      do ja = 1 ,nuco2
+        do jl = 1 , kdlon
+          zu_i (jl,ja,jk) = 0.
+          zup_i (jl,ja,jk) = 0.
+          zu_j (jl,ja,jk) = 0.
+          zup_j (jl,ja,jk) = 0.
+          zt_aer_i (jl,ja,jk) = 1.
+          zt_aer_j (jl,ja,jk) = 1.
+        enddo
+      enddo
+
+      if (linear) then
+
+      do nlmd = 1 ,ncouche
+        cn(nlmd)=(1.0/ncouche)
+        cb(nlmd)=(ncouche-nlmd+0.5)/ncouche
+c       print*,nlmd,cb(nlmd),cn(nlmd)
+      enddo
+
+      else
+
+      do nlmd = 1 ,ncouche-1
+        cn(nlmd)=(1-alphan)*alphan**(nlmd-1)
+        cb(nlmd)=0.5*(1+alphan)*alphan**(nlmd-1)
+      enddo
+      cn(ncouche)=alphan**(ncouche-1)
+      cb(ncouche)=0.5*alphan**(ncouche-1)
+
+      endif
+
+c test
+      if (nmax .LT. ncouche) then
+        print*,'!!!!! ATTENTION !!!!! '
+        print*,'probleme dans lwxn.F'
+        print*,' nmax=',nmax,'  < ncouche=',ncouche
+        call exit(1)
+      endif
+
+c----------------------------------------------------------------------
+      do jk = 1 , nlaylte-1
+c----------------------------------------------------------------------
+c         1.0   (co2) amount and (aer) transmission for all sublayers  
+c               ----------------------------------------------------
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c                                                        layer i (down)
+c                                                        -------------
+      zu_layer_i(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jk+1)
+      zup_layer_i(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jk+1)
+      zt_aer_layer_i(jl,ja) = aer_t(jl,ja,jk)
+     .                       / aer_t(jl,ja,jk+1)
+                                  
+      do nlmd=1,ncouche
+        zu_i(jl,ja,nlmd)=cn(nlmd)*zu_layer_i(jl,ja)
+        zup_i(jl,ja,nlmd)=cn(nlmd)*zup_layer_i(jl,ja)
+        zt_aer_i(jl,ja,nlmd)=zt_aer_layer_i(jl,ja)**cn(nlmd)
+      enddo
+
+c                                                          layer j (up)
+c                                                          ------------
+      zu_layer_j(jl,ja) =  co2_u(jl,ja,jk+1)  - co2_u(jl,ja,jk+2)
+      zup_layer_j(jl,ja) = co2_up(jl,ja,jk+1) - co2_up(jl,ja,jk+2)
+      zt_aer_layer_j(jl,ja) = aer_t(jl,ja,jk+1)
+     .                       / aer_t(jl,ja,jk+2)
+        
+      do nlmd=1,ncouche
+        zu_j(jl,ja,nlmd)=cn(nlmd)*zu_layer_j(jl,ja)
+        zup_j(jl,ja,nlmd)=cn(nlmd)*zup_layer_j(jl,ja)
+        zt_aer_j(jl,ja,nlmd)=zt_aer_layer_j(jl,ja)**cn(nlmd)
+      enddo
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         2.0   transmissions between all sublayers
+c               ------------------------------------
+
+        do ni = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=ni,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_i(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_i(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_i(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+c on ajoute la couche J
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_j(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_j(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_j(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+        
+        do nj = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=nj,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_j(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_j(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_j(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+c on ajoute la couche I
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_i(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_i(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_i(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+        
+c----------------------------------------------------------------------
+c         3.0   global exchange coefficiant between neigthbours
+c               -----------------------------------------------
+        
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            ksi(jl,ja,jk) = 0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ni+1,ncouche+1)
+     .             - trans(jl,ja,ni,ncouche+1)
+     .             - trans(jl,ja,ni+1,1)
+     .             + trans(jl,ja,ni,1) )
+     .             * (cb(ni)*dp(jl,jk)) * 2    
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do nj = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ncouche+1,nj+1)
+     .             - trans(jl,ja,1,nj+1)
+     .             - trans(jl,ja,ncouche+1,nj)
+     .             + trans(jl,ja,1,nj) )
+     .             * (cb(nj)*dp(jl,jk+1)) * 2 
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+     .                            + xi_emis(ig0+jl,ja,jk)
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+            xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         4.0   Special treatment for ground
+c               ----------------------------
+
+
+      if (jk .EQ. 1) then
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi_ground(ig0+jl,ja)=0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+
+      xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
+     .                     + ( trans(jl,ja,ni+1,ncouche+1)
+     .                        -trans(jl,ja,ni,ncouche+1))
+     .                     * 2 * cb(ni)
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+      enddo    !  boucle sur jk
+c----------------------------------------------------------------------
+      return
+      end
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/lwxn_SP36.old	(revision 46)
@@ -0,0 +1,388 @@
+      subroutine lwxn ( kdlon,kflev
+     .                , dp
+     .                , aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXN   computes transmission function and exchange coefficiants
+c                        for neighbours layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |   |   |   |   |***| 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |   |   |   |***| 0 |***|   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |   |   |***| 0 |***|   |   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |   |***| 0 |***|   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |***| 0 |***|   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |***|   |   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |   |   |   |   |   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+c                                                                       
+c  *********************************************************** nj=1
+c
+c
+c                                       sublayer    1                  
+c
+c
+c                                ----------------------------- nj=2
+c
+c                                       sublayer    2                  
+c
+c    - - - -  LAYER j - - - - -  ----------------------------- nj=3
+c
+c                                       sublayer    3                  
+c                                ----------------------------- nj=4
+c                                       sublayer  ncouche                  
+c  *********************************************************** ni=nj=ncouche+1
+c                                       sublayer  ncouche                  
+c                                ----------------------------- ni=4
+c                                       sublayer    3                  
+c
+c    - - - -  LAYER i - - - - -  ----------------------------- ni=3
+c
+c                                       sublayer    2                  
+c                     
+c                                ----------------------------- ni=2
+c
+c
+c                                       sublayer    1                  
+c
+c
+c  *********************************************************** ni=1
+c                                                                       
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon     ! part of ngrid
+      integer kflev     ! part of nalyer
+
+      real dp (ndlo2,kflev)              ! layer pressure thickness (Pa)
+
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,nlmd,ni,nj
+
+      integer nmax
+      parameter (nmax=50)               ! max: 50 sublayers
+
+      real cn (nmax), cb (nmax)
+
+      real zu_layer_i (ndlon,nuco2)
+      real zup_layer_i (ndlon,nuco2)
+      real zt_aer_layer_i (ndlon,nuco2)
+
+      real zu_layer_j (ndlon,nuco2)
+      real zup_layer_j (ndlon,nuco2)
+      real zt_aer_layer_j (ndlon,nuco2)
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real zu_i (ndlon,nuco2,nmax+1)
+      real zup_i (ndlon,nuco2,nmax+1)
+      real zu_j (ndlon,nuco2,nmax+1)
+      real zup_j (ndlon,nuco2,nmax+1)
+      real zt_aer_i (ndlon,nuco2,nmax+1)
+      real zt_aer_j (ndlon,nuco2,nmax+1)
+
+      real trans (ndlon,nuco2,nmax+1,nmax+1)
+      real ksi (ndlon,nuco2,nflev-1)
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      jk=ncouche+1
+      do ja = 1 ,nuco2
+        do jl = 1 , kdlon
+          zu_i (jl,ja,jk) = 0.
+          zup_i (jl,ja,jk) = 0.
+          zu_j (jl,ja,jk) = 0.
+          zup_j (jl,ja,jk) = 0.
+          zt_aer_i (jl,ja,jk) = 1.
+          zt_aer_j (jl,ja,jk) = 1.
+        enddo
+      enddo
+
+      if (linear) then
+
+      do nlmd = 1 ,ncouche
+        cn(nlmd)=(1.0/ncouche)
+        cb(nlmd)=(ncouche-nlmd+0.5)/ncouche
+c       print*,nlmd,cb(nlmd),cn(nlmd)
+      enddo
+
+      else
+
+      do nlmd = 1 ,ncouche-1
+        cn(nlmd)=(1-alphan)*alphan**(nlmd-1)
+        cb(nlmd)=0.5*(1+alphan)*alphan**(nlmd-1)
+      enddo
+      cn(ncouche)=alphan**(ncouche-1)
+      cb(ncouche)=0.5*alphan**(ncouche-1)
+
+      endif
+
+c test
+      if (nmax .LT. ncouche) then
+        print*,'!!!!! ATTENTION !!!!! '
+        print*,'probleme dans lwxn.F'
+        print*,' nmax=',nmax,'  < ncouche=',ncouche
+        call exit(1)
+      endif
+
+c----------------------------------------------------------------------
+      do jk = 1 , nlaylte-1
+c----------------------------------------------------------------------
+c         1.0   (co2) amount and (aer) transmission for all sublayers  
+c               ----------------------------------------------------
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c                                                        layer i (down)
+c                                                        -------------
+      zu_layer_i(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jk+1)
+      zup_layer_i(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jk+1)
+      zt_aer_layer_i(jl,ja) = aer_t(jl,ja,jk)
+     .                       / aer_t(jl,ja,jk+1)
+                                  
+      do nlmd=1,ncouche
+        zu_i(jl,ja,nlmd)=cn(nlmd)*zu_layer_i(jl,ja)
+        zup_i(jl,ja,nlmd)=cn(nlmd)*zup_layer_i(jl,ja)
+        zt_aer_i(jl,ja,nlmd)=zt_aer_layer_i(jl,ja)**cn(nlmd)
+      enddo
+
+c                                                          layer j (up)
+c                                                          ------------
+      zu_layer_j(jl,ja) =  co2_u(jl,ja,jk+1)  - co2_u(jl,ja,jk+2)
+      zup_layer_j(jl,ja) = co2_up(jl,ja,jk+1) - co2_up(jl,ja,jk+2)
+      zt_aer_layer_j(jl,ja) = aer_t(jl,ja,jk+1)
+     .                       / aer_t(jl,ja,jk+2)
+        
+      do nlmd=1,ncouche
+        zu_j(jl,ja,nlmd)=cn(nlmd)*zu_layer_j(jl,ja)
+        zup_j(jl,ja,nlmd)=cn(nlmd)*zup_layer_j(jl,ja)
+        zt_aer_j(jl,ja,nlmd)=zt_aer_layer_j(jl,ja)**cn(nlmd)
+      enddo
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         2.0   transmissions between all sublayers
+c               ------------------------------------
+
+        do ni = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=ni,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_i(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_i(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_i(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+c on ajoute la couche J
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_j(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_j(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_j(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+        
+        do nj = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=nj,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_j(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_j(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_j(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+c on ajoute la couche I
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_i(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_i(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_i(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+        
+c----------------------------------------------------------------------
+c         3.0   global exchange coefficiant between neigthbours
+c               -----------------------------------------------
+        
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            ksi(jl,ja,jk) = 0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ni+1,ncouche+1)
+     .             - trans(jl,ja,ni,ncouche+1)
+     .             - trans(jl,ja,ni+1,1)
+     .             + trans(jl,ja,ni,1) )
+     .             * (cb(ni)*dp(jl,jk)) * 2    
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do nj = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ncouche+1,nj+1)
+     .             - trans(jl,ja,1,nj+1)
+     .             - trans(jl,ja,ncouche+1,nj)
+     .             + trans(jl,ja,1,nj) )
+     .             * (cb(nj)*dp(jl,jk+1)) * 2 
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi(jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+     .                            + xi_emis(jl,ja,jk)
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+            xi(jl,ja,jk+1,jk) = xi(jl,ja,jk,jk+1)
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         4.0   Special treatment for ground
+c               ----------------------------
+
+
+      if (jk .EQ. 1) then
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi_ground(jl,ja)=0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+
+      xi_ground(jl,ja) = xi_ground(jl,ja)
+     .                     + ( trans(jl,ja,ni+1,ncouche+1)
+     .                        -trans(jl,ja,ni,ncouche+1))
+     .                     * 2 * cb(ni)
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+      enddo    !  boucle sur jk
+c----------------------------------------------------------------------
+      return
+      end
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mkstat.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mkstat.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mkstat.F90	(revision 46)
@@ -0,0 +1,164 @@
+subroutine mkstats(ierr)
+
+ 
+!
+!  This program writes a stats.nc file from sums and sums of squares
+!  to means and standard deviations and also writes netcdf style
+!  file so that the data can be viewed easily.  The data file is
+!  overwritten in place.  
+!  SRL  21 May 1996
+!  Yann W. july 2003
+
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
+integer, dimension(4) :: id,varid,start,size
+integer, dimension(5) :: dimids
+character (len=50) :: name,nameout,units,title
+real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
+real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
+real, dimension(istime) :: time
+real, dimension(jjp1) :: lat
+real, dimension(iip1) :: lon
+real, dimension(llm) :: alt
+logical :: lcopy=.true.
+!integer :: latid,lonid,altid,timeid
+integer :: meanid,sdid
+!integer, dimension(4) :: dimout
+
+! Incrementation of count for the last step, which is not done in wstats
+count(istime)=count(istime)+1
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+! We catch the id of dimensions of the stats file
+
+ierr= NF_INQ_DIMID(nid,"latitude",id(1))
+ierr= NF_INQ_DIMID(nid,"longitude",id(2))
+ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+ierr= NF_INQ_VARID(nid,"latitude",varid(1))
+ierr= NF_INQ_VARID(nid,"longitude",varid(2))
+ierr= NF_INQ_VARID(nid,"altitude",varid(3))
+ierr= NF_INQ_VARID(nid,"Time",varid(4))
+
+! Time initialisation
+
+do i=1,istime
+   time(i)=i*24./istime
+#ifdef NC_DOUBLE
+   ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i))
+#else
+   ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i))
+#endif
+enddo
+
+! We catche the values of the variables
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,varid(1),lat)
+         ierr = NF_GET_VAR_REAL(nid,varid(2),lon)
+         ierr = NF_GET_VAR_REAL(nid,varid(3),alt)
+#endif
+
+! We catch the number of variables in the stats file
+ierr = NF_INQ_NVARS(nid,nbvar)
+
+! to catche the "real" number of variables (without the "additionnal variables")
+nbvar=(nbvar-4)/2 
+
+do i=1,nbvar
+   varid=(i-1)*2+5
+
+   ! What's the variable's name?
+   ierr=NF_INQ_VARNAME(nid,varid,name)
+   write(*,*) "OK variable ",name
+   ! Its units?
+   units=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
+   ! Its title?
+   title=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
+   ! Its number of dimensions?   
+   ierr=NF_INQ_VARNDIMS(nid,varid,ndims)
+   ! Its values?
+
+   if(ndims==4) then ! lat, lon, alt & time
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=altid
+!      dimout(4)=timeid
+
+      size=(/iip1,jjp1,llm,1/)
+      do lt=1,istime
+         start=(/1,1,1,lt/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d)
+#endif
+         ! Calculation of these variables
+         mean3d=sum3d/count(lt)
+         sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d)
+#endif
+      enddo
+
+    else if (ndims.eq.3) then
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=timeid
+
+      size=(/iip1,jjp1,1,0/)
+      do lt=1,istime
+         start=(/1,1,lt,0/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d)
+#endif
+         ! Calculation of these variables
+         mean2d=sum2d/count(lt)
+         sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d)
+#endif
+      enddo
+
+    endif 
+enddo
+
+ierr= NF_CLOSE(nid)
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mucorr.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mucorr.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mucorr.F	(revision 46)
@@ -0,0 +1,102 @@
+      SUBROUTINE mucorr(npts,pdeclin, plat, pmu, pfract,phaut,prad)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         pdeclin          solar declinaison
+c         plat(npts)        latitude
+c         phaut            hauteur typique de l'atmosphere
+c         prad             rayon planetaire
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL phaut,prad,pdeclin
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b, tp
+      REAL alph
+
+c-----------------------------------------------------------------------
+
+      pi = 4. * atan(1.0)
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+   
+         IF(t.eq.0.) then
+            tp=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + pi
+            ELSE
+               tp = atan(t)
+            ENDIF
+         ENDIF
+         t = tp
+   
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+   20 CONTINUE
+
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+      alph=phaut/prad
+      DO 30 j=1,npts
+c !!!!!!
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+c    $          (sqrt(alph*alph*pmu(j)*pmu(j)+2.*alph+1.)-alph*pmu(j))
+30    CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mufract.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mufract.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/mufract.F	(revision 46)
@@ -0,0 +1,92 @@
+      SUBROUTINE mufract(jjm,pdecli, plat, pmu, pfract)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         jjm              number of points
+c         pdecli           solar declinaison
+c         plat(jjm)        latitude
+c
+c      Output :
+c      --------
+c         pmu(jjm)          equivalent cosinus of the solar angle
+c         pfract(jjm)       fractionnal day
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+c
+c     Arguments :
+c     -----------
+
+      INTEGER jjm
+      REAL plat(jjm),pmu(jjm), pfract(jjm)
+      REAL pdecli
+c
+c     Local variables :
+c     -----------------
+
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b
+c
+c=======================================================================
+c
+      pi = 4. * atan(1.0)
+      z = pdecli
+      cz = cos (z*pi/180.)
+      sz = sin (z*pi/180.)
+c
+      DO 20 j = 1, jjm
+c
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+         IF(t.eq.0.) THEN
+            t=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) THEN
+               t = -atan (-t) + pi
+            ELSE
+               t = atan(t)
+            ENDIF
+         ENDIF
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) THEN
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+c
+   20 CONTINUE
+c
+      RETURN
+      END
+c
+c* end of mufract
+c=======================================================================
+c
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/multipl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/multipl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/multipl.F	(revision 46)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newcondens.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newcondens.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newcondens.F	(revision 46)
@@ -0,0 +1,874 @@
+      SUBROUTINE 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
+  
+c           Tendencies on T, U, V, Q 
+c           """"""""""""""""""""""""
+            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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newsedim.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newsedim.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/newsedim.F	(revision 46)
@@ -0,0 +1,185 @@
+      SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+     &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Compute sedimentation of 1 tracer 
+c      of radius rd (m) and density rho (kg.m-3) 
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,naersize
+      REAL ptimestep            ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+      real masse (ngrid,nlay) ! masse d'une couche (kg)
+      real epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+      real rd(naersize)             ! particle radius (m)
+      real rho             ! particle density (kg.m-3)
+
+
+c    Traceurs :
+      real pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+      real wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, k, i
+      REAL rfall
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      real traversee (ngridmx,nlayermx)
+      real vstokes(ngridmx,nlayermx)
+      real w(ngridmx,nlayermx)
+      real ptop, dztop, Ep, Stra
+
+      DATA firstcall/.true./
+
+c    Physical constant
+c    ~~~~~~~~~~~~~~~~~
+      REAL visc, molrad
+c     Gas molecular viscosity (N.s.m-2)
+      data visc/1.e-5/       ! CO2
+c     Effective gas molecular radius (m)
+      data molrad/2.2e-10/   ! CO2
+
+c     local and saved variable
+      real a,b
+      save a,b
+
+
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans newsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+
+
+c       Preliminary calculations for sedimenation velocity :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       - Constant to compute stokes speed simple formulae
+c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+         b = 2./9. * g / visc
+
+c       - Constant  to compute gas mean free path
+c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+         a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+
+c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+c   (correction = 0.85 for irregular particles, 0.5 for disk shaped particles)
+c        a = a    * 0.85
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c     Sedimentation velocity (m/s)
+c     ~~~~~~~~~~~~~~~~~~~~~~
+c     (stokes law corrected for low pressure by the Cunningham
+c     slip-flow correction  according to Rossow (Icarus 36, 1-50, 1978)
+
+        do  l=1,nlay
+          do ig=1, ngrid
+            if (naersize.eq.1) then 
+              rfall=rd(1)
+            else
+              i=ngrid*(l-1)+ig
+              rfall=rd(i)
+            endif  
+            vstokes(ig,l) = b * rho * rfall**2 *
+     &      (1 + 1.333* ( a*pt(ig,l)/pplev(ig,l) )/rfall)
+
+c           Layer crossing time (s) :
+            traversee(ig,l)= epaisseur(ig,l)/vstokes(ig,l)
+          end do
+        end do
+
+
+c     Calcul de la masse d'atmosphere correspondant a q transferee
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     (e.g. on recherche le niveau  en dessous de laquelle le traceur
+c      va traverser le niveau intercouche l : "dztop" est sa hauteur
+c      au dessus de l (m), "ptop" est sa pression (Pa))
+
+      do  l=1,nlay
+        do ig=1, ngrid
+             
+             dztop = vstokes(ig,l)*  ptimestep 
+             Ep=0
+             k=0
+
+c **************************************************************
+c            Simple Method
+             w(ig,l) =
+     &       (1- exp(-dztop*g/(r*pt(ig,l))))*pplev(ig,l) / g
+cc           write(*,*) 'OK simple method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK simple method dztop =', dztop
+c **************************************************************
+cccc         Complex method :
+            if (dztop.gt.epaisseur(ig,l)) then
+cccc            Cas ou on "epuise" la couche l : On calcule le flux
+cccc            Venant de dessus en tenant compte de la variation de Vstokes
+
+               Ep= epaisseur(ig,l)
+               Stra= traversee(ig,l)
+               do while(dztop.gt.Ep.and.l+k+1.le.nlay)
+                 k=k+1
+                 dztop= Ep + vstokes(ig,l+k)*(ptimestep -Stra)
+                 Ep = Ep + epaisseur(ig,l+k)
+                 Stra = Stra + traversee(ig,l+k)
+               enddo 
+               Ep = Ep - epaisseur(ig,l+k)
+             end if
+             ptop=pplev(ig,l+k)*exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+             w(ig,l) = (pplev(ig,l) -Ptop)/g
+c
+cc           write(*,*) 'OK new    method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK new    method dztop =', dztop
+cc       if(l.eq.7)write(*,*)'l=7,k,pplev,Ptop',pplev(ig,l),Ptop
+cc       if(l.eq.7)write(*,*)'l=7,dztop,Ep',dztop,Ep
+cc            if(l.eq.6)write(*,*)'l=6,k, w',k, w(1,l)
+cc            if(l.eq.7)write(*,*)'l=7,k, w',k, w(1,l)
+cc            if(l.eq.8)write(*,*)'l=8,k, w',k, w(1,l)
+c **************************************************************
+        end do
+      end do
+
+      call vlz_fi(ngrid,pqi,2.,masse,w,wq)
+c         write(*,*) ' newsed: wq(6), wq(7), q(6)',
+c    &                wq(1,6),wq(1,7),pqi(1,6)
+
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nirco2abs.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nirco2abs.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nirco2abs.F	(revision 46)
@@ -0,0 +1,144 @@
+      SUBROUTINE nirco2abs(ngrid,nlayer,pplay,dist_sol,
+     $     mu0,fract,declin,pdtnirco2)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing heating rate due to
+c   absorption by CO2 in the near-infrared
+c   This version includes NLTE effects
+c
+c   (Scheme to be described in Forget et al., JGR, 2003)
+c   (old Scheme described in Forget et al., JGR, 1999)
+c
+c   This version updated with a new functional fit,
+c   see NLTE correction-factor of Lopez-Valverde et al (1998)
+c   Stephen Lewis 2000
+c  
+c   08/2002 : correction for bug when running with diurnal=F
+c
+c   author:  Frederic Hourdin 1996 
+c   ------
+c            Francois Forget 1999 
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   dist_sol              sun-Mars distance (AU)
+c   mu0(ngridmx)          
+c   fract(ngridmx)        day fraction of the time interval
+c   declin                latitude of subslar point
+c
+c   output:
+c   -------
+c
+c   pdtnirco2(ngrid,nlayer)      Heating rate (K/s)
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer
+
+      REAL pplay(ngrid,nlayer)
+      REAL dist_sol,mu0(ngridmx),fract(ngridmx),declin
+
+      REAL pdtnirco2(ngrid,nlayer)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig, n, nstep
+      REAL co2heat0, zmu(ngridmx)
+
+c     special diurnal=F 
+      real mu0_int(ngridmx),fract_int(ngridmx),zday_int
+      real ztim1,ztim2,ztim3,step
+
+c
+c   local saved variables
+c   ---------------------
+
+c     p0noonlte is a pressure below which non LTE effects are significant.
+c     REAL p0nonlte
+c     DATA p0nonlte/7.5e-3/
+c     SAVE p0nonlte
+
+c     parameters for CO2 heating fit
+      real n_a, n_p0, n_b
+      parameter (n_a=1.1956475)
+      parameter (n_b=1.9628251)
+      parameter (n_p0=0.0015888279)
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+c     co2heat is the heating by CO2 at 700Pa for a zero zenithal angle.
+      co2heat0=n_a*(1.52/dist_sol)**2/daysec
+
+c     Simple calcul for a given sun incident angle (if diurnal=T)
+c     --------------------------------------------
+
+      IF (diurnal) THEN  
+         do ig=1,ngrid
+            zmu(ig)=sqrt(1224.*mu0(ig)*mu0(ig)+1.)/35.
+         enddo
+         do l=1,nlayer
+           do ig=1,ngrid
+             if(fract(ig).gt.0.) pdtnirco2(ig,l)=
+     &             co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &             /(1.+n_p0/pplay(ig,l))**n_b
+
+c           OLD SCHEME (forget et al. 1999)
+c    s           co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+c    s          / (1+p0nonlte/pplay(ig,l))
+           enddo
+         enddo
+
+c     Averaging over diurnal cycle (if diurnal=F)
+c     -------------------------------------------
+c     NIR CO2 abs is slightly non linear. To remove the diurnal
+c     cycle, it is better to average the heating rate over 1 day rather
+c     than using the mean mu0 computed by mucorr in physiq.F (FF, 1998)
+
+      ELSE      ! if (.not.diurnal) then
+
+         nstep = 20   ! number of integration step /sol
+         do n=1,nstep
+            zday_int = (n-1)/float(nstep)
+            ztim2=COS(declin)*COS(2.*pi*(zday_int-.5))
+            ztim3=-COS(declin)*SIN(2.*pi*(zday_int-.5))
+            CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s             ztim1,ztim2,ztim3,
+     s             mu0_int,fract_int)
+            do ig=1,ngrid
+               zmu(ig)=sqrt(1224.*mu0_int(ig)*mu0_int(ig)+1.)/35.
+            enddo
+            do l=1,nlayer
+               do ig=1,ngrid
+                  if(fract_int(ig).gt.0.) pdtnirco2(ig,l)=
+     &                 pdtnirco2(ig,l) + (1/float(nstep))*
+     &                 co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &                 /(1.+n_p0/pplay(ig,l))**n_b
+               enddo
+            enddo
+         end do
+      END IF
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltecool.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltecool.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltecool.F	(revision 46)
@@ -0,0 +1,306 @@
+c**************************************************************************
+c
+      subroutine nltecool(ngrid,nlayer,pplay,pt,dtnlte)
+c
+c This code was designed as a delivery for the "Martian Environment Models" 
+c project ( ESA contract 11369/95/nl/jg CCN2 )
+c Computes non-LTE heating rates from CO2 emission at 15 um
+c in the Martian upper atmosphere.
+c Uses a simplified model consisting of two excited levels with two
+c emission bands, one of them stronger than the other, which correspond
+c to the behaviours of the 626 fundamental band and the isotopic fund.bands.
+c It uses a cool-to-space approximation with tabulated escape functions.
+c These escape functions have been precomputed for the strong and weak bands,
+c and are given as a function of pressure in separate files.
+c The output values are the heating rates (actually, cooling, since they
+c are always negative) for the two bands, i.e., the total cooling is the
+c sum of them.
+c Miguel A. Lopez Valverde
+c Instituto de Astrofisica de Andalucia (CSIC), Granada, Spain
+c
+c Version 1b.  See description above.  22-March-2000.
+c Adapted as a subroutine for use in GCM -- PLR/SRL 6/2000
+c Version 1c.  Inclusion of VMR in the tabulation of escape functions. 
+c              Table contains now only 1 input file -- Miguel 11/Jul/2000
+c Version 1d  data contained in original input file "nlte_escape.dat"
+c now stored in include file "nltedata.h" Y.Wanherdrick 09/2000
+c     
+c***************************************************************************
+
+      implicit none
+
+#include "nltedata.h" ! (Equivalent to the reading of the "nlte_escape.dat" file)
+ 
+c Input and output variables
+c
+      integer     ngrid                           ! no. of horiz. gridpoints
+      integer     nlayer                          ! no. of atmospheric layers
+      real        pplay(ngrid,nlayer)             ! input pressure grid
+      real        pt(ngrid,nlayer)                ! input temperatures
+      real        dtnlte(ngrid,nlayer)            ! output temp. tendencies
+
+c
+c Standard atmosphere variables
+c
+      real        nt                              ! number density [cm-3]
+      real        co2(nlayer)                     !  "   of CO2
+      real        o3p(nlayer)                     !  "   of atomic oxygen
+      real        n2co(nlayer)                    !  "  of N2 + CO
+      real        pyy(nlayer)                     ! auxiliary pressure grid
+
+c
+c Vectors and indexes for the tabulation of escape functions and VMR
+c
+c                 np                              ! # data points in tabulation
+c                 pnb(np)                         ! Pressure in tabulation
+c                 ef1(np)                         ! Esc.funct.#1, tabulated
+c                 ef2(np)                         ! Esc.funct.#2, tabulated
+c                 co2vmr(np)                      ! CO2 VMR tabulated
+c                 o3pvmr(np)                      ! CO2 VMR tabulated
+c                 n2covmr(np)                     ! N2+CO VMR tabulated
+      real        escf1(nlayer)                   ! Esc.funct.#1, interpolated
+      real        escf2(nlayer)                   ! Esc.funct.#2, interpolated
+
+
+c
+c Local Constants
+c
+      real       nu1, nu2                         ! freq. of energy levels
+      real       imr1, imr2                       ! isotopic abundances
+      real       hplanck, gamma, vlight           ! physical constants
+      real       ee
+      real       rfvt                             ! collisional rate
+      real       rfvto3p                          !     "
+      real       rfvv                             !     "
+
+c
+c Local variables for the main loop
+c
+      real       n1, n2, co2t                     ! ground populations
+      real       l1, p1, p12                      ! prod & losses
+      real       l2, p2, p21
+      real       tt                               ! dummy variable
+      real       c1, c2                           ! molecular constants
+      real       ae1, ae2                         ! einstein spontaneous emission
+      real       a1, a2, a12, a21
+      real       pl1, pl2
+      real       el1, el2
+      real       hr1, hr2                         ! heating rate due to each band
+      real       hr(nlayer)                       ! total heating rate
+
+c
+c Indexes
+c
+      integer    i
+      integer    j,ii
+
+c
+c Rate coefficients
+c
+      real       k19xca, k19xcb
+      real       k19cap1, k19cap2
+      real       k19cbp1, k19cbp2
+      real       d19c, d19cp1, d19cp2
+      real       k20xc, k20cp1, k20cp2
+      real       k21xc, k21cp2
+
+      logical    firstcall
+      data       firstcall/.true./
+      save       firstcall,ef1,ef2,co2vmr,n2covmr,o3pvmr,pnb
+
+c
+c Data
+c
+      data       nu1, nu2, hplanck, gamma, vlight, ee/
+     1     667.38, 662.3734, 6.6261e-27, 1.191e-5, 3.e10, 1.438769/
+
+c*************************************************************************
+c       PROGRAM  STARTS
+c*************************************************************************
+
+      imr1 = 0.987
+      imr2 = 0.00408 + 0.0112
+      rfvt = 0.1
+      rfvto3p = 1.0
+      rfvv = 0.1
+
+      if(firstcall) then
+
+         do i=1,np
+            pnb(i)=1.0e-4*exp(pnb(i)) ! p into Pa
+         end do
+
+         firstcall = .false.
+
+      endif
+
+c
+c MAIN LOOP, for each gridpoint and altitude:
+c
+      do j=1,ngrid  ! loop over grid points
+c
+c set up local pressure grid
+c
+         do ii=1,nlayer
+            pyy(ii)=pplay(j,ii)
+         enddo
+!
+! Interpolate escape functions and VMR to the desired grid
+!
+         call interp1(escf2,pyy,nlayer,ef2,pnb,np)
+         call interp1(escf1,pyy,nlayer,ef1,pnb,np)
+         call interp3(co2,o3p,n2co,pyy,nlayer,
+     &        co2vmr,o3pvmr,n2covmr,pnb,np)
+        
+         do i=1,nlayer  ! loop over layers
+C
+C test if p lies outside range (p > 3.5 Pa)
+C changed to 1 Pa since transition will always be higher than this
+C
+            if(pyy(i) .gt. 1.0 .or. pyy(i) .lt. 4.0e-6) then 
+               hr(i)=0.0
+               dtnlte(j,i)=0.0
+            else
+c
+c           if(pt(j,i).lt.1.0)print*,pt(j,i)
+               nt = pyy(i)/(1.381e-17*pt(j,i)) ! nt in cm-3
+               co2(i)=co2(i)*nt                ! CO2 density in cm-3
+               o3p(i)=o3p(i)*nt                ! O3p density in cm-3
+               n2co(i)=n2co(i)*nt              ! N2+CO in cm-3
+c molecular populations
+               n1 = co2(i) * imr1
+               n2 = co2(i) * imr2
+               co2t = n1 + n2
+
+c intermediate collisional rates
+               tt = pt(j,i)*pt(j,i)
+
+               if (pt(j,i).le.175.0) then
+                  k19xca = 3.3e-15
+                  k19xcb = 7.6e-16
+               else
+                  k19xca = 4.2e-12 * exp( -2988.0/pt(j,i) + 303930.0/tt)
+                  k19xcb = 2.1e-12 * exp( -2659.0/pt(j,i) + 223052.0/tt)
+               endif
+               k19xca = k19xca * rfvt
+               k19xcb = k19xcb * rfvt
+               k19cap1 = k19xca * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cap2 = k19xca * 2.0 * exp( -ee*nu2/pt(j,i) )
+               k19cbp1 = k19xcb * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cbp2 = k19xcb * 2.0 * exp( -ee*nu2/pt(j,i) )
+               d19c = k19xca*co2t + k19xcb*n2co(i)
+               d19cp1 = k19cap1*co2t + k19cbp1*n2co(i)
+               d19cp2 = k19cap2*co2t + k19cbp2*n2co(i)
+                                !
+               k20xc = 3.e-12 * rfvto3p
+               k20cp1 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu1 )
+               k20cp2 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu2 )
+                                !
+               k21xc = 2.49e-11 * 0.5 * rfvv
+               k21cp2 = k21xc * exp( - ee/pt(j,i) * (nu2-nu1) )
+                                !
+               l1 = d19c + k20xc*o3p(i) + k21cp2*n2
+               p1 = ( d19cp1 + k20cp1*o3p(i) ) * n1
+               p12 = k21xc*n1
+                                !
+               l2 = d19c + k20xc*o3p(i) + k21xc*n1
+               p2 = ( d19cp2 + k20cp2*o3p(i) ) * n2
+               p21 = k21cp2*n2
+
+c radiative rates
+               ae1 = 1.3546 * 1.66 / 4.0 * escf1(i)
+               ae2 = ( 1.3452 + 1.1878 ) * 1.66 / 4.0 * escf2(i)
+               l1 = l1 + ae1
+               l2 = l2 + ae2
+
+c solving the system
+               c1 = gamma*nu1**3. * 0.5
+               c2 = gamma*nu2**3. * 0.5
+               a1 = c1 * p1 / (n1*l1)
+               a2 = c2 * p2 / (n2*l2)
+               a12 = (nu1/nu2)**3. * n2/n1 * p12/l1
+               a21 = (nu2/nu1)**3. * n1/n2 * p21/l2
+               el2 = (a2 + a21 * a1 ) / ( 1.0 - a21 * a12 )
+               el1 = a1 + a12 * el2
+               pl1 = el1 * n1 / c1
+               pl2 = el2 * n2 / c2
+
+c  heating rate
+               hr1 = - hplanck*vlight * nu1 * ae1 * pl1
+               hr2 = - hplanck*vlight * nu2 * ae2 * pl2
+               hr(i) = hr1 + hr2
+               dtnlte(j,i)=0.1*hr(i)*pt(j,i)/(4.4*pyy(i)) ! dtnlte in K s-1
+c              write(7,25)pxx(i),hr1,hr2,hr(i),qt
+c  25         format(' ',1p5e12.4)
+
+            endif
+
+         enddo  ! end loop over layers
+      enddo     ! end loop over grid points
+c     close(7)
+c
+        return
+        end
+
+c***********************************************************************
+
+      subroutine interp1(escout,p,nlayer,escin,pin,nl)
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if(p(n1) .gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            escout(n1) = 0.0
+         else
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            escout(n1) = escin(nm)*wm + escin(np)*wp
+         endif
+      enddo
+      return
+      end
+
+c***********************************************************************
+
+      subroutine interp3(esco1,esco2,esco3,p,nlayer,
+     1     esci1,esci2,esci3,pin,nl)
+C
+C subroutine to perform 3 simultaneous linear interpolations in pressure from 
+C 1D profiles esci1-3(nl) sampled on pressure grid pin(nl) to 1D profiles 
+C esco1-3(nlayer) on pressure grid p(ngrid,nlayer).
+C
+      real esco1(nlayer),esco2(nlayer),esco3(nlayer),p(nlayer)
+      real esci1(nl),    esci2(nl),    esci3(nl),    pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if (p(n1).gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            esco1(n1)=0.0
+            esco2(n1)=0.0
+            esco3(n1)=0.0
+         else 
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            esco1(n1) = esci1(nm)*wm + esci1(np)*wp
+            esco2(n1) = esci2(nm)*wm + esci2(np)*wp
+            esco3(n1) = esci3(nm)*wm + esci3(np)*wp
+         endif
+      enddo
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltedata.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltedata.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nltedata.h	(revision 46)
@@ -0,0 +1,166 @@
+c INCLUDE nlte_escape.h
+       !
+       ! Escape functions and VMRs from tabulated values.
+       ! Origin: nlte_escape.dat file form Miguel L.
+       ! (Y. Wanherdrick, 09/2000)
+
+       integer     np
+       parameter ( np = 68 )                ! # data points in tabulation
+       real        pnb(np)                  ! Pressure in tabulation
+       real        ef1(np)                  ! Esc.funct.#1, tabulated
+       real        ef2(np)                  ! Esc.funct.#2, tabulated
+       real        co2vmr(np)               ! CO2 VMR tabulated
+       real        o3pvmr(np)               ! CO2 VMR tabulated
+       real        n2covmr(np)              ! N2+CO VMR tabulated
+ 
+ 
+      DATA pnb/
+     &    12.0000,    11.0000,    10.8000,
+     &    10.6000,   10.40000,   10.20000,
+     &   10.00000,    9.80000,    9.60000,
+     &    9.40000,    9.20000,    9.00000,
+     &    8.80000,    8.60000,    8.40000,
+     &    8.20000,    8.00000,    7.80000,
+     &    7.60000,    7.40000,    7.20000,
+     &    7.00000,    6.80000,    6.60000,
+     &    6.40000,    6.20000,    6.00000,
+     &    5.80000,    5.60000,    5.40000,
+     &    5.20000,    5.00000,    4.80000,
+     &    4.60000,    4.40000,    4.20000,
+     &    4.00000,    3.80000,    3.60000,
+     &    3.40000,    3.20000,    3.00000,
+     &    2.80000,    2.60000,    2.40000,
+     &    2.20000,    2.00000,    1.80000,
+     &    1.60000,    1.40000,    1.20000,
+     &    1.00000,   0.800000,   0.599999,
+     &   0.400000,   0.200000,  0.,
+     &  -0.200000,  -0.400001,  -0.600000,
+     &  -0.800000,   -1.00000,   -1.20000,
+     &   -1.40000,   -1.60000,   -1.80000,
+     &   -2.00000,   -3.00000/
+ 
+      DATA ef1/
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.61707E-04,    4.76886E-04,
+     &    4.95638E-04,    5.20935E-04,    5.55511E-04,
+     &    6.01219E-04,    6.63734E-04,    7.50691E-04,
+     &    8.63474E-04,    1.00900E-03,    1.19642E-03,
+     &    1.42690E-03,    1.71398E-03,    2.06663E-03,
+     &    2.48974E-03,    3.01578E-03,    3.64350E-03,
+     &    4.40323E-03,    5.32066E-03,    6.40456E-03,
+     &    7.72069E-03,    9.25684E-03,    1.10905E-02,
+     &    1.32374E-02,    1.57643E-02,    1.87388E-02,
+     &    2.22072E-02,    2.63099E-02,    3.10614E-02,
+     &    3.66948E-02,    4.32373E-02,    5.15022E-02,
+     &    6.21455E-02,    7.77212E-02,    9.92027E-02,
+     &   0.131155,   0.179470,   0.258913,
+     &   0.380549,   0.530450,   0.643180,
+     &   0.741061,   0.826336,   0.922787,
+     &   0.997203,    1.00000/
+ 
+      DATA ef2/
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    2.01376E-03,
+     &    2.09450E-03,    2.22993E-03,    2.42056E-03,
+     &    2.68018E-03,    3.04398E-03,    3.43896E-03,
+     &    3.80282E-03,    4.20622E-03,    4.76121E-03,
+     &    8.01698E-03,    1.19947E-02,    1.69149E-02,
+     &    2.24497E-02,    2.85244E-02,    3.54813E-02,
+     &    4.39264E-02,    5.46248E-02,    6.75367E-02,
+     &    8.29931E-02,    1.01717E-01,   0.123422,
+     &   0.148468,   0.177096,   0.208816,
+     &   0.244003,   0.282013,   0.322559,
+     &   0.365542,   0.410518,   0.457384,
+     &   0.505358,   0.553627,   0.600472,
+     &   0.644807,   0.687185,   0.727429,
+     &   0.764734,   0.798562,   0.828699,
+     &   0.854797,   0.877717,   0.897874,
+     &   0.915258,   0.929904,   0.942381,
+     &   0.952906,   0.962173,   0.970191,
+     &   0.976437,   0.981501,   0.985406,
+     &   0.988560,   0.991111,   0.993653,
+     &   0.995561,    1.00000/
+ 
+      DATA co2vmr/
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.949619,   0.947694,   0.945830,
+     &   0.944016,   0.940557,   0.937068,
+     &   0.932366,   0.893661/
+ 
+      DATA o3pvmr/
+     &    5.06756E-08,    9.16539E-07,    1.68217E-06,
+     &    3.00843E-06,    5.03151E-06,    8.07489E-06,
+     &    1.23137E-05,    1.79029E-05,    2.45308E-05,
+     &    3.27431E-05,    4.26692E-05,    5.44396E-05,
+     &    6.78865E-05,    8.33147E-05,    1.00148E-04,
+     &    1.18846E-04,    1.39681E-04,    1.64909E-04,
+     &    1.93617E-04,    2.25161E-04,    2.60834E-04,
+     &    3.01501E-04,    3.44953E-04,    3.91011E-04,
+     &    4.40377E-04,    4.90820E-04,    5.43200E-04,
+     &    5.95335E-04,    6.45420E-04,    6.93166E-04,
+     &    7.43729E-04,    7.93710E-04,    8.44394E-04,
+     &    8.94318E-04,    9.44732E-04,    9.94964E-04,
+     &    1.04901E-03,    1.10008E-03,    1.16302E-03,
+     &    1.22989E-03,    1.30026E-03,    1.37131E-03,
+     &    1.45556E-03,    1.55186E-03,    1.66328E-03,
+     &    1.77802E-03,    1.91546E-03,    2.07503E-03,
+     &    2.24903E-03,    2.47117E-03,    2.71728E-03,
+     &    2.99739E-03,    3.33582E-03,    3.73507E-03,
+     &    4.20819E-03,    4.76887E-03,    5.42558E-03,
+     &    6.20815E-03,    7.14473E-03,    8.28545E-03,
+     &    9.51779E-03,    1.08140E-02,    1.22359E-02,
+     &    1.36870E-02,    1.51495E-02,    1.67196E-02,
+     &    1.85485E-02,    3.36252E-02/
+ 
+      DATA n2covmr/
+     &    2.71412E-02,    2.71464E-02,    2.71490E-02,
+     &    2.71523E-02,    2.71558E-02,    2.71617E-02,
+     &    2.71672E-02,    2.71749E-02,    2.71837E-02,
+     &    2.71943E-02,    2.72058E-02,    2.72189E-02,
+     &    2.72326E-02,    2.72483E-02,    2.72661E-02,
+     &    2.72848E-02,    2.73054E-02,    2.73279E-02,
+     &    2.73514E-02,    2.73775E-02,    2.74048E-02,
+     &    2.74345E-02,    2.74672E-02,    2.75021E-02,
+     &    2.75404E-02,    2.75826E-02,    2.76340E-02,
+     &    2.77013E-02,    2.78220E-02,    2.79707E-02,
+     &    2.81759E-02,    2.84339E-02,    2.87587E-02,
+     &    2.91600E-02,    2.96561E-02,    3.02558E-02,
+     &    3.09922E-02,    3.18062E-02,    3.27010E-02,
+     &    3.35635E-02,    3.44388E-02,    3.53327E-02,
+     &    3.62143E-02,    3.70941E-02,    3.79315E-02,
+     &    3.87626E-02,    3.95524E-02,    4.03071E-02,
+     &    4.10071E-02,    4.16229E-02,    4.21231E-02,
+     &    4.25167E-02,    4.27964E-02,    4.29773E-02,
+     &    4.30488E-02,    4.29638E-02,    4.28049E-02,
+     &    4.26788E-02,    4.26822E-02,    4.29426E-02,
+     &    4.34634E-02,    4.42559E-02,    4.53038E-02,
+     &    4.65879E-02,    4.80262E-02,    4.96303E-02,
+     &    5.14885E-02,    6.91651E-02/
+ 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlteparams.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlteparams.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlteparams.h	(revision 46)
@@ -0,0 +1,18 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'nlteparams.h'
+c
+c   Parameters which govern the transition from LTE to NLTE radiation
+c   tendencies.
+c-----------------------------------------------------------------------
+
+      real ptrans           ! central pressure for transition (Pa)
+      parameter (ptrans = 0.1)
+      real zw               ! half-width for transition (scale heights)
+      parameter (zw = 0.5)
+      real pminte           ! pressure up to which LTE is calculated (Pa)
+      parameter (pminte = 0.4*ptrans)
+c     almost one scale height above transition in worst case is very safe
+      real zwi
+      parameter (zwi = 2./zw)
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlthermeq.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlthermeq.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/nlthermeq.F	(revision 46)
@@ -0,0 +1,58 @@
+      subroutine nlthermeq(ngrid, nlayer, pplev, pplay)
+c
+c  Compute the number of layers nlaylte (stored in common yomlw.h)
+c  over which local thermodynamic equilibrium
+c  radiation scheme should be run to be sure of covering at least to a
+c  height greater than (pressure lower than) p=pminte, set in nlteparams.h.
+c  The maximum layer needed is found for the worst possible case.
+c  Stephen Lewis 6/2000
+c  Modified Y. Wanherdrick/ F. Forget 09/2000
+
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+#include "callkeys.h"
+
+c
+c     Input:
+      integer ngrid, nlayer
+      real pplev(ngrid, nlayer+1)
+      real pplay(ngrid, nlayer)
+c
+c     Local:
+      integer igpmax, ismax
+      logical firstcall
+      data firstcall /.true./
+      save firstcall, igpmax
+c
+      if(firstcall) then
+c     Find the location of maximum surface pressure.
+c     Location won't vary much so only do it at the start;
+c     with no topography location would vary, but this is only
+c     needed for an estimate so any point would do in that case.
+         igpmax = ismax(ngrid, pplev, 1)
+         write(*, 10) ptrans
+         write(*, 20) zw
+         write(*, 30) pminte
+         firstcall = .false.
+      endif
+c
+      IF(callnlte) then
+c       Find first layer above pminte at this location
+        do nlaylte = nlayer, 1, -1
+           if (pplay(igpmax, nlaylte).gt.pminte)  go to 100
+        enddo
+      ELSE
+        nlaylte=nlayer
+      END IF
+  100 write(*,*) 'LTE rad. calculations up to layer ',  nlaylte
+c
+      return
+c
+   10 format(' nlthermeq: transition to NLTE centred at ',f6.2,'Pa')
+   20 format('               half-width (scale heights) ',f6.2)
+   30 format('          suggested LTE coverage at least ',f6.2,'Pa')
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orbite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orbite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orbite.F	(revision 46)
@@ -0,0 +1,63 @@
+      SUBROUTINE orbite(pls,pdist_sol,pdecli)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c   Distance from sun and declimation as a function of the solar
+c   longitude Ls
+c
+c   Interface:
+c   ----------
+c
+c
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pls          Ls
+c
+c   Output:
+c   -------
+c   pdist_sol     Distance Sun-Planet in UA
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,pls,i
+
+c-----------------------------------------------------------------------
+
+c Distance Sun-Planet
+
+      pdist_sol=p_elips/(1.+e_elips*cos(pls+timeperi))
+
+c Solar declination
+
+c ********************* version before 01/01/2000 *******
+
+      pdecli= asin (sin(pls)*sin(obliquit*pi/180.))
+
+c ********************* version after 01/01/2000 *******
+c     i=obliquit*pi/180.
+c     pdecli=asin(sin(pls)*sin(i)/sqrt(sin(pls)**2+
+c    & cos(pls)**2*cos(i)**2))
+c ******************************************************
+
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orodrag.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orodrag.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orodrag.F	(revision 46)
@@ -0,0 +1,286 @@
+      SUBROUTINE ORODRAG( klon,klev 
+     I                 , KGWD, KGWDIM, KDX, KTEST
+     R                 , PTSPHY
+     R                 , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1
+     R                 , PVM1, PVAROR, PSIG, PGAMMA, PTHETA
+C OUTPUTS
+     R                 , PULOW,PVLOW
+     R                 , PVOM,PVOL,PTE )
+C
+C
+C**** *ORODRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION.
+C
+C     PURPOSE.
+C     --------
+C
+C          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
+C          PROGNOSTIC VARIABLES U,V  AND T DUE TO  VERTICAL TRANSPORTS BY
+C          SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     PTSPHY             : LENGTH OF TIME STEP
+C     PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS
+C     PAPM1(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PGEOM1(NLON,NLEV)  : GEOPOTENTIAL HIEGHT OF MODEL LEVELS
+C     PTM1(NLON,NLEV)    : TEMPERATURE
+C     PUM1(NLON,NLEV)    : ZONAL WIND
+C     PVM1(NLON,NLEV)    : MERIDIONAL WIND
+C     PVAROR(NLON)       : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAMMA(NLON)       : SUB-GRID SCALE ANISOTROPY
+C     PTHETA(NLON)       : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PVOM(NLON,NLEV)    : ZONAL WIND TENDENCY
+C     PVOL(NLON,NLEV)    : MERIDIONAL WIND TENDENCY
+C     PTE(NLON,NLEV)     : TEMPERATURE TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C     yoegwd.h
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C     REFERENCE.
+C     ----------
+C
+C     AUTHOR.
+C     -------
+C     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.
+C
+C     F.LOTT + M. MILLER    E.C.M.W.F.     22/11/94
+C-----------------------------------------------------------------------
+      implicit none
+C
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+      parameter(kidia=1,kfdia=NDLO2)
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+C
+      REAL  PTE(NDLO2,klev),
+     *      PVOL(NDLO2,klev),
+     *      PVOM(NDLO2,klev),
+     *      PULOW(NDLO2),
+     *      PVLOW(NDLO2)
+      REAL  PUM1(NDLO2,klev),
+     *      PVM1(NDLO2,klev),
+     *      PTM1(NDLO2,klev),
+     *      PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2),
+     *      PGEOM1(NDLO2,klev),
+     *      PAPM1(NDLO2,klev),
+     *      PAPHM1(NDLO2,klev+1)
+C
+      integer kgwd,kgwdim
+      real ptsphy
+      INTEGER  KDX(NDLO2),KTEST(NDLO2)
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      INTEGER  ISECT(NDLO2),
+     *         ICRIT(NDLO2),
+     *         IKCRITH(NDLO2),
+     *         IKenvh(NDLO2),
+     *         IKNU(NDLO2),
+     *         IKNU2(NDLO2),
+     *         IKCRIT(NDLO2),
+     *         IKHLIM(NDLO2)
+      integer ji,jk,jl,klevm1,ilevp1
+C      real gkwake
+      real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
+      real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
+C
+      REAL   ZTAU(NDLO2,nlayermx+1),
+     *       ZSTAB(NDLO2,nlayermx+1),
+     *       ZVPH(NDLO2,nlayermx+1),
+     *       ZRHO(NDLO2,nlayermx+1),
+     *       ZRI(NDLO2,nlayermx+1),
+     *       ZpsI(NDLO2,nlayermx+1),
+     *       Zzdep(NDLO2,nlayermx)
+      REAL   ZDUDT(NDLO2),
+     *       ZDVDT(NDLO2),
+     *       ZDTDT(NDLO2),
+     *       ZDEDT(NDLO2),
+     *       ZVIDIS(NDLO2),
+     *       ZTFR(NDLO2),
+     *       Znu(NDLO2),
+     *       Zd1(NDLO2),
+     *       Zd2(NDLO2),
+     *       Zdmod(NDLO2)
+C
+C------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+ 110  CONTINUE
+C
+c     ZTMST=TWODT
+c     IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
+      KLEVM1=KLEV-1
+      ZTMST=PTSPHY
+      ZRTMST=1./ZTMST
+C     ------------------------------------------------------------------
+C
+ 120  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.3   CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
+C                ---------------------------------------------
+C
+ 130  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.     PRECOMPUTE BASIC STATE VARIABLES.
+C*                ---------- ----- ----- ----------
+C*                DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+  200 CONTINUE
+C
+C
+C
+      CALL OROSETUP
+     *     ( klon, klev , KTEST 
+     *     , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2
+     *     , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1 , PGEOM1, pvaror
+     *     , ZRHO  , ZRI   , ZSTAB  , ZTAU , ZVPH , zpsi, zzdep
+     *     , PULOW, PVLOW 
+     *     , ptheta,pgamma,znu  ,zd1,  zd2,  zdmod                )
+C
+C
+C
+C***********************************************************
+C
+C
+C*         3.      COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
+C*                 SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
+C*                 AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
+C
+  300 CONTINUE
+C
+      CALL GWSTRESS
+     *    ( klon  , klev
+     *    , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU
+     *    , ZRHO  , ZSTAB, ZVPH  , PVAR , pvaror,  psig
+     *    , ZTFR   , ZTAU 
+     *    , pgeom1,pgamma,zd1,zd2,zdmod,znu)
+C
+C*         4.      COMPUTE STRESS PROFILE.
+C*                 ------- ------ --------
+C
+  400 CONTINUE
+C
+C
+      CALL GWPROFIL
+     *       (  klon , klev
+     *       , kgwd   , kdx  , KTEST
+     *       , IKCRIT, IKCRITH, ICRIT  , ikenvh, IKNU
+     *       ,iknu2 , pAPHM1, ZRHO   , ZSTAB , ZTFR   , ZVPH
+     *       , ZRI   , ZTAU   , ztauf
+     *       , zdmod , znu    , psig  , pgamma , pvaror   )
+C
+C
+C*         5.      COMPUTE TENDENCIES.
+C*                 -------------------
+C
+  500 CONTINUE
+C
+C  EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
+C  IMPLICIT SOLUTION FOR THE BLOCKED LEVELS
+
+      DO 510 JL=KIDIA,KFDIA
+      ZVIDIS(JL)=0.0
+      ZDUDT(JL)=0.0
+      ZDVDT(JL)=0.0
+      ZDTDT(JL)=0.0
+  510 CONTINUE
+C
+      ILEVP1=KLEV+1
+C
+C
+      DO 524 JK=1,klev
+C
+CDIR$ IVDEP
+C
+C      GKWAKE=0.5
+C
+C     NOW SET IN SUGWD.F
+C
+      DO 523 JL=1,KGWD
+      JI=KDX(JL)
+      ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK)
+      ZTEMP=-g*(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)*ZDELP)
+      ZDUDT(JI)=(PULOW(JI)*Zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      ZDVDT(JI)=(pvLOW(JI)*Zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      if(jk.ge.ikenvh(ji)) then
+         zb=1.0-0.18*pgamma(ji)-0.04*pgamma(ji)**2
+         zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2
+         zconb=2.*ztmst*GKWAKE*psig(ji)/(4.*pvaror(ji))
+         zabsv=sqrt(PUM1(JI,JK)**2+PVM1(JI,JK)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      PVOM(JI,JK)=ZDUDT(JI)
+      PVOL(JI,JK)=ZDVDT(JI)
+      ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI)
+      ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI)
+      ZDIS=0.5*(PUM1(JI,JK)**2+PVM1(JI,JK)**2-ZUST**2-ZVST**2)
+      ZDEDT(JI)=ZDIS/ZTMST
+      ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP
+      ZDTDT(JI)=ZDEDT(JI)/cpp
+      PTE(JI,JK)=ZDTDT(JI)
+
+  523 CONTINUE
+
+  524 CONTINUE
+C
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orosetup.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orosetup.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/orosetup.F	(revision 46)
@@ -0,0 +1,494 @@
+      SUBROUTINE OROSETUP
+     *         ( klon   , klev  , KTEST
+     *         , KKCRIT, KKCRITH, KCRIT, KSECT , KKHLIM
+     *         , kkenvh, kknu  , kknu2
+     *         , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1  , PGEOM1, pvaror
+     *         , PRHO  , PRI   , PSTAB  , PTAU , PVPH  ,ppsi, pzdep
+     *         , PULOW , PVLOW  
+     *         , Ptheta, pgamma,  pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+C**** *GWSETUP*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *ORODRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F.LOTT  FOR THE NEW-GWDRAG SCHEME NOVEMBER 1993
+C
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),kkenvh(NDLO2)
+
+C
+      REAL PAPHM1(NDLO2,KLEV+1),PAPM1(NDLO2,KLEV),PUM1(NDLO2,KLEV),
+     *     PVM1(NDLO2,KLEV),PTM1(NDLO2,KLEV),PGEOM1(NDLO2,KLEV),
+     *     PRHO(NDLO2,KLEV+1),PRI(NDLO2,KLEV+1),PSTAB(NDLO2,KLEV+1),
+     *     PTAU(NDLO2,KLEV+1),PVPH(NDLO2,KLEV+1),ppsi(NDLO2,klev+1),
+     *     pzdep(NDLO2,klev)
+       REAL PULOW(NDLO2),PVLOW(NDLO2),ptheta(NDLO2),pgamma(NDLO2),
+     *     pnu(NDLO2),
+     *     pd1(NDLO2),pd2(NDLO2),pdmod(NDLO2)
+      real pvaror(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      LOGICAL LL1(NDLO2,nlayermx+1)
+      integer kknu(NDLO2),kknu2(NDLO2),kknub(NDLO2),kknul(NDLO2),
+     *        kentp(NDLO2),ncount(NDLO2)  
+C
+      REAL ZHCRIT(NDLO2,nlayermx),ZNCRIT(NDLO2,nlayermx),
+     *     ZVPF(NDLO2,nlayermx), ZDP(NDLO2,nlayermx)
+      REAL ZNORM(NDLO2),zpsi(NDLO2),zb(NDLO2),zc(NDLO2),
+     *      zulow(NDLO2),zvlow(NDLO2),znup(NDLO2),znum(NDLO2)
+C
+c   declarations pour "implicit none"
+      integer jk,jl,ilevm1,ilevm2,ilevh
+      real zu,zphi,zcons1,zcons2,zcons3,zwind,zdwind,zhgeo
+      real zvt1,zvt2,zst,zvar,zdelp,zstabm,zstabp,zrhom,zrhop
+      real alpha,zggeenv,zggeom1,zgvar
+      logical lo
+
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+c     print *,' entree gwsetup'
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+
+      kidia=1
+	  kfdia=klon
+
+ 110  CONTINUE
+C
+      ILEVM1=KLEV-1
+      ILEVM2=KLEV-2
+      ILEVH =KLEV/3
+C
+      ZCONS1=1./r
+cold  ZCONS2=G**2/CPD
+      ZCONS2=g**2/cpp
+cold  ZCONS3=1.5*API
+      ZCONS3=1.5*PI
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.
+C                --------------
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+C
+C
+      DO 2001 JL=kidia,kfdia
+      kknu(JL)    =klev
+      kknu2(JL)   =klev
+      kknub(JL)   =klev
+      kknul(JL)   =klev
+      pgamma(JL) =max(pgamma(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 CONTINUE
+C
+C*      DEFINE TOP OF LOW LEVEL FLOW
+C       ----------------------------
+      DO 2002 JK=KLEV,ilevh,-1
+      DO 2003 JL=kidia,kfdia
+      LO=(PAPHM1(JL,JK)/PAPHM1(JL,KLEV+1)).GE.GSIGCR
+      IF(LO) THEN
+        KKCRIT(JL)=JK
+      ENDIF
+      ZHCRIT(JL,JK)=4.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu(JL)=JK
+      ENDIF
+ 2003 CONTINUE
+ 2002 CONTINUE
+      DO 2004 JK=KLEV,ilevh,-1
+      DO 2005 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=3.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu2(JL)=JK
+      ENDIF
+ 2005 CONTINUE
+ 2004 CONTINUE
+      DO 2006 JK=KLEV,ilevh,-1
+      DO 2007 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=2.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknub(JL)=JK
+      ENDIF
+ 2007 CONTINUE
+ 2006 CONTINUE
+      DO 2008 JK=KLEV,ilevh,-1
+      DO 2009 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknul(JL)=JK
+      ENDIF
+ 2009 CONTINUE
+ 2008 CONTINUE
+C
+      do 2010 jl=kidia,kfdia  
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      if(kknub(jl).eq.nktopg) kknul(jl)=klev
+C
+C     CHANGE IN HERE TO STOP KKNUL=KKNUB
+C
+      if(kknul(jl).le.kknub(jl)) kknul(jl)=nktopg
+ 2010 continue      
+C
+
+ 210  CONTINUE
+C
+C
+CC*     INITIALIZE VARIOUS ARRAYS
+C
+      DO 2107 JL=kidia,kfdia
+      PRHO(JL,KLEV+1)  =0.0
+      PSTAB(JL,KLEV+1) =0.0
+      PSTAB(JL,1)      =0.0
+      PRI(JL,KLEV+1)   =9999.0
+      ppsi(JL,KLEV+1)  =0.0
+      PRI(JL,1)        =0.0
+      PVPH(JL,1)       =0.0
+      PULOW(JL)        =0.0
+      PVLOW(JL)        =0.0
+      zulow(JL)        =0.0
+      zvlow(JL)        =0.0
+      KKCRITH(JL)      =KLEV
+      KKenvH(JL)       =KLEV
+      Kentp(JL)        =KLEV
+      KCRIT(JL)        =1
+      ncount(JL)       =0
+      ll1(JL,klev+1)   =.false.
+ 2107 CONTINUE
+C
+C*     DEFINE LOW-LEVEL FLOW
+C      ---------------------
+C
+      DO 223 JK=KLEV,2,-1
+      DO 222 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PRHO(JL,JK)=2.*PAPHM1(JL,JK)*ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+        PSTAB(JL,JK)=2.*ZCONS2/(PTM1(JL,JK)+PTM1(JL,JK-1))*
+     *  (1.-cpp*PRHO(JL,JK)*(PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+        PSTAB(JL,JK)=MAX(PSTAB(JL,JK),GSSEC)
+      ENDIF
+  222 CONTINUE
+  223 CONTINUE
+C
+C********************************************************************
+C
+C*     DEFINE blocked FLOW
+C      -------------------
+      DO 2115 JK=klev,ilevh,-1
+      DO 2116 JL=kidia,kfdia
+      if(jk.ge.kknub(jl).and.jk.le.kknul(jl)) then
+        pulow(JL)=pulow(JL)+PUM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+        pvlow(JL)=pvlow(JL)+PVM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+      end if
+ 2116 CONTINUE
+ 2115 CONTINUE
+      DO 2110 JL=kidia,kfdia
+      pulow(JL)=pulow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      pvlow(JL)=pvlow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      ZNORM(JL)=MAX(SQRT(PULOW(JL)**2+PVLOW(JL)**2),GVSEC)
+      PVPH(JL,KLEV+1)=ZNORM(JL)
+ 2110 CONTINUE
+C
+C*******  SETUP OROGRAPHY AXES AND DEFINE PLANE OF PROFILES  *******
+C
+      DO 2112 JL=kidia,kfdia
+      LO=(PULOW(JL).LT.GVSEC).AND.(PULOW(JL).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PULOW(JL)+2.*GVSEC
+      ELSE
+        ZU=PULOW(JL)
+      ENDIF
+      Zphi=ATAN(PVLOW(JL)/ZU)
+      ppsi(jl,klev+1)=ptheta(jl)*pi/180.-zphi
+      zb(jl)=1.-0.18*pgamma(jl)-0.04*pgamma(jl)**2
+      zc(jl)=0.48*pgamma(jl)+0.3*pgamma(jl)**2
+      pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+      pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
+      pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+ 2112 CONTINUE
+C
+C  ************ DEFINE FLOW IN PLANE OF LOWLEVEL STRESS *************
+C
+      DO 213 JK=1,KLEV
+      DO 212 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1)  THEN
+        ZVt1       =PULOW(JL)*PUM1(JL,JK)+PVLOW(JL)*PVM1(JL,JK)
+        ZVt2       =-PvLOW(JL)*PUM1(JL,JK)+PuLOW(JL)*PVM1(JL,JK)
+        ZVPF(JL,JK)=(zvt1*pd1(jl)+zvt2*pd2(JL))/(znorm(jl)*pdmod(jl))
+      ENDIF
+      PTAU(JL,JK)  =0.0
+      Pzdep(JL,JK) =0.0
+      Ppsi(JL,JK)  =0.0
+      ll1(JL,JK)   =.FALSE.
+  212 CONTINUE
+  213 CONTINUE
+      DO 215 JK=2,KLEV
+      DO 214 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PVPH(JL,JK)=((PAPHM1(JL,JK)-PAPM1(JL,JK-1))*ZVPF(JL,JK)+
+     *            (PAPM1(JL,JK)-PAPHM1(JL,JK))*ZVPF(JL,JK-1))
+     *            /ZDP(JL,JK)
+        IF(PVPH(JL,JK).LT.GVSEC) THEN
+          PVPH(JL,JK)=GVSEC
+          KCRIT(JL)=JK
+        ENDIF
+      ENDIF
+  214 CONTINUE
+  215 CONTINUE
+C
+C
+C*         2.2     BRUNT-VAISALA FREQUENCY AND DENSITY AT HALF LEVELS.
+C
+  220 CONTINUE
+C
+      DO 2211 JK=ilevh,KLEV
+      DO 221 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      IF(jk.ge.(kknub(jl)+1).and.jk.le.kknul(jl)) THEN
+           ZST=ZCONS2/PTM1(JL,JK)*(1.-cpp*PRHO(JL,JK)*
+     *                   (PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+           PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)+ZST*ZDP(JL,JK)
+           PSTAB(JL,KLEV+1)=MAX(PSTAB(JL,KLEV+1),GSSEC)
+           PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)+PAPHM1(JL,JK)*2.*ZDP(JL,JK)
+     *                   *ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+      ENDIF
+      ENDIF
+  221 CONTINUE
+ 2211 CONTINUE
+C
+      DO 2212 JL=kidia,kfdia
+C*****************************************************************************
+C
+C     O.K. THERE IS A POSSIBLE PROBLEM HERE. IF KKNUL=KKNUB THEN
+C     DIVISION BY ZERO OCCURS. I HAVE PUT A FIX IN HERE BUT WILL ASK FRANCOIS 
+C     LOTT ABOUT IT IN PARIS.
+C
+C     MAT COLLINS 30.1.96
+C
+C     ALSO IF THIS IS THE CASE PSTAB AND PRHO ARE NOT DEFINED AT KLEV+1
+C     SO I HAVE ADDED THE ELSE
+C
+C*****************************************************************************
+      IF (KKNUL(JL).NE.KKNUB(JL)) THEN
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+      ELSE
+      WRITE(*,*) 'OROSETUP: KKNUB=KKNUL= ',KKNUB(JL),' AT JL= ',JL
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV)
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV)
+      ENDIF
+        ZVAR=PVARor(JL)
+ 2212 CONTINUE
+C
+C*         2.3     MEAN FLOW RICHARDSON NUMBER.
+C*                 AND CRITICAL HEIGHT FOR FROUDE LAYER
+C
+  230 CONTINUE
+C
+      DO 232 JK=2,KLEV
+      DO 231 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDWIND=MAX(ABS(ZVPF(JL,JK)-ZVPF(JL,JK-1)),GVSEC)
+        PRI(JL,JK)=PSTAB(JL,JK)*(ZDP(JL,JK)
+     *          /(g*PRHO(JL,JK)*ZDWIND))**2
+        PRI(JL,JK)=MAX(PRI(JL,JK),GRCRIT)
+      ENDIF
+  231 CONTINUE
+  232 CONTINUE
+C
+C
+C*      DEFINE TOP OF 'envelope' layer
+C       ----------------------------
+
+      DO 233 JL=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  CONTINUE
+      
+      DO 234 JK=2,KLEV-1
+      DO 234 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+       
+      IF (JK.GE.KKNU2(JL)) THEN
+          
+            ZNUM(JL)=PNU(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            PNU(JL) = PNU(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.GFRCRIT).AND.(PNU(JL).GT.GFRCRIT)
+     *                          .AND.(KKENVH(JL).EQ.KLEV))
+     *      KKENVH(JL)=JK
+     
+      ENDIF    
+
+      ENDIF
+      
+ 234  CONTINUE
+
+C  CALCULATION OF A DYNAMICAL MIXING HEIGHT FOR THE BREAKING
+C  OF GRAVITY WAVES:
+
+              
+      DO 235 JL=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  CONTINUE
+
+      DO 236 JK=KLEV-1,2,-1
+      DO 236 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+        
+      IF (JK.LT.KKENVH(JL)) THEN
+
+            ZNUM(JL)=ZNUP(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            ZNUP(JL) = ZNUP(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.1.5).AND.(ZNUP(JL).GT.1.5)
+     *                          .AND.(KKCRITH(JL).EQ.KLEV))
+     *      KKCRITH(JL)=JK
+     
+      ENDIF
+      
+      ENDIF
+      
+ 236  CONTINUE
+ 
+      DO 237 JL=KIDIA,KFDIA
+      KKCRITH(JL)=MIN0(KKCRITH(JL),KKNU(JL))
+ 237  CONTINUE
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=ilevh,klev    
+      DO 252 JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+      LO=(PUm1(JL,jk).LT.GVSEC).AND.(PUm1(JL,jk).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PUm1(JL,jk)+2.*GVSEC
+      ELSE
+        ZU=PUm1(JL,jk)
+      ENDIF
+       Zphi=ATAN(PVm1(JL,jk)/ZU)
+       ppsi(jl,jk)=ptheta(jl)*pi/180.-zphi
+      end if
+ 252  continue
+ 251  CONTINUE
+c      forms the vertical 'leakiness' **************************
+
+      alpha=3.
+      
+      DO 254  JK=ilevh,klev
+      DO 253  JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+        zggeenv=AMAX1(1.,
+     *          (pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)-1))/2.)      
+        zggeom1=AMAX1(pgeom1(jl,jk),1.)
+        zgvar=amax1(pvaror(jl)*g,1.)     
+        pzdep(jl,jk)=SQRT((zggeenv-zggeom1)/(zggeom1+zgvar))      
+      end if
+ 253  CONTINUE
+ 254  CONTINUE
+
+ 260  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/phyetat0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/phyetat0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/phyetat0.F	(revision 46)
@@ -0,0 +1,594 @@
+      SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,nq,
+     .           day_ini,time,
+     .           tsurf,tsoil,emis,q2,qsurf,co2ice)
+      implicit none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+!#include "tracer.h"
+#include"advtrac.h"
+c======================================================================
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+!======================================================================
+!  Arguments:
+!  ---------
+!  inputs:
+      character*(*) fichnom ! "startfi.nc" file
+      integer tab0
+      integer Lmodif
+      integer nsoil ! # of soil layers
+      integer nq
+      integer day_ini
+      real time
+
+!  outputs:
+      real tsurf(ngridmx,nbsrf) ! surface temperature
+      real tsoil(ngridmx,nsoil,nbsrf) ! soil temperature
+      real emis(ngridmx) ! surface emissivity
+      real q2(ngridmx, llm+1) ! 
+      real qsurf(ngridmx,nq) ! tracers on surface
+      real co2ice(ngridmx) ! co2 ice cover
+
+!======================================================================
+!  Local variables:
+
+!      INTEGER radpas
+!      REAL co2_ppm
+!      REAL solaire
+
+      real xmin,xmax ! to display min and max of a field
+c
+      INTEGER ig,iq,lmax
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf
+!      integer isoil 
+!      INTEGER length
+!      PARAMETER (length=100)
+      CHARACTER*7 str7
+      CHARACTER*2 str2
+      CHARACTER*1 yes
+c
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+      INTEGER nqold
+
+! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+
+ 
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+
+! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+!                    qsurf02, ...)
+      count=0
+      do iq=1,nqmx
+        txt= " "
+        write(txt,'(a5,i2.2)')'qsurf',iq
+        ierr=NF_INQ_VARID(nid,txt,nvarid)
+        if (ierr.ne.NF_NOERR) then
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          count=count+1
+        endif
+      enddo
+      if (count.eq.nqmx) then
+        write(*,*) "phyetat0:tracers seem to follow old naming ",
+     &             "convention (qsurf01,qsurf02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldtracernames=.true.
+      endif
+
+c modifications possibles des variables de tab_cntrl
+      PRINT*
+      write(*,*) 'TABFI de phyeta0',Lmodif,tab0
+      call tabfi (nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .              p_omeg,p_g,p_mugaz,p_daysec,time)
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lati)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, lati)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, long)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, long)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "area", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <area> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, area)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, area)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <area>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(area)
+      xmax = MAXVAL(area)
+      PRINT*,'Aires des mailles <area>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisfi", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <phisfi> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisfi)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisfi)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(phisfi)
+      xmax = MAXVAL(phisfi)
+      PRINT*,'Geopotentiel au sol <phisfi>:', xmin, xmax
+c
+c Lecture de l''albedo du sol nu:
+c
+      ierr = NF_INQ_VARID (nid, "albedodat", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <albedodat> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albedodat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, albedodat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(albedodat)
+      xmax = MAXVAL(albedodat)
+      PRINT*,'Albedo du sol nu <albedodat>:', xmin, xmax
+c
+c Lecture de l''inertie thermique du sol:
+c
+!      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
+!#else
+!      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+!#endif
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+!         CALL abort
+!      ENDIF
+!      xmin = 1.0E+20
+!      xmax = -1.0E+20
+!      xmin = MINVAL(inertiedat)
+!      xmax = MAXVAL(inertiedat)
+!      PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
+c
+c ZMEA
+c
+      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zmea(i),xmin)
+         xmax = MAX(zmea(i),xmax)
+      ENDDO
+      PRINT*,'<zmea>:', xmin, xmax
+c
+c ZSTD
+c
+      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zstd(i),xmin)
+         xmax = MAX(zstd(i),xmax)
+      ENDDO
+      PRINT*,'<zstd>:', xmin, xmax
+c
+c ZSIG
+c
+      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zsig(i),xmin)
+         xmax = MAX(zsig(i),xmax)
+      ENDDO
+      PRINT*,'<zsig>:', xmin, xmax
+c
+c ZGAM
+c
+      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zgam(i),xmin)
+         xmax = MAX(zgam(i),xmax)
+      ENDDO
+      PRINT*,'<zgam>:', xmin, xmax
+c
+c ZTHE
+c
+      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zthe(i),xmin)
+         xmax = MAX(zthe(i),xmax)
+      ENDDO
+      PRINT*,'<zthe>:', xmin, xmax
+c
+c CO2 ice cover
+c
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <co2ice> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, co2ice)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, co2ice)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(co2ice)
+      xmax = MAXVAL(co2ice)
+      PRINT*,'CO2 ice cover <co2ice>:', xmin, xmax
+c
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <tsurf> est absent'
+         PRINT*, '          Mais je vais essayer de lire TS**'
+         IF (nbsrf.GT.99) THEN
+            PRINT*, "Trop de sous-mailles"
+            CALL abort
+         ENDIF
+         DO nsrf = 1, nbsrf
+           WRITE(str2,'(i2.2)') nsrf
+           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
+              CALL abort
+           ENDIF
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,nsrf))
+#else
+           ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,nsrf))
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
+             CALL abort
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(tsurf)
+           xmax = MAXVAL(tsurf)
+           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
+         ENDDO
+      ELSE
+         PRINT*, 'phyetat0: Le champ <tsurf> est present'
+         PRINT*, '          J ignore donc les autres temperatures TS**'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         xmin = MINVAL(tsurf)
+         xmax = MAXVAL(tsurf)
+         PRINT*,'Temperature du sol <tsurf>', xmin, xmax
+         IF (nbsrf >= 2) THEN
+            DO nsrf = 2, nbsrf
+               DO i = 1, ngridmx
+                  tsurf(i,nsrf) = tsurf(i,1)
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+!      IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
+!         PRINT*, "Trop de couches ou sous-mailles"
+!         CALL abort
+!      ENDIF
+!      DO nsrf = 1, nbsrf
+!         DO isoil=1, nsoil
+!            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+!            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+!            IF (ierr.NE.NF_NOERR) THEN
+!               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+!               PRINT*, "          Il prend donc la valeur de surface"
+!               DO i=1, ngridmx
+!                  tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
+!               ENDDO
+!            ELSE
+!#ifdef NC_DOUBLE
+!              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
+!#else
+!              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+!#endif
+!               IF (ierr.NE.NF_NOERR) THEN
+!                  PRINT*, "Lecture echouee pour <tsoil>"
+!                  CALL abort
+!               ENDIF
+!            ENDIF
+!         ENDDO
+!      ENDDO
+!      xmin = 1.0E+20
+!      xmax = -1.0E+20
+!      xmin = MINVAL(tsoil)
+!      xmax = MAXVAL(tsoil)
+!      PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
+c
+c Surface emissivity
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <emis> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, emis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, emis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <emis>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(emis)
+      xmax = MAXVAL(emis)
+      PRINT*,'Surface emissivity <emis>:', xmin, xmax
+c
+c pbl wind variance
+c
+      ierr = NF_INQ_VARID (nid, "q2", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <q2> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q2)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, q2)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <q2>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(q2)
+      xmax = MAXVAL(q2)
+      PRINT*,'pbl wind variance <q2>:', xmin, xmax
+c
+c tracer on surface
+c
+
+      IF(nq.GE.1) THEN
+         nqold=nq
+         DO iq=1,nq
+!            str7(1:5)='qsurf'
+!            WRITE(str7(6:7),'(i2.2)') iq
+!            ierr = NF_INQ_VARID (nid,str7,nvarid)
+           IF (oldtracernames) THEN
+             txt=" "
+             write(txt,'(a5,i2.2)')'qsurf',iq
+           ELSE
+             txt=tnom(iq)
+             if (txt.eq."h2o_vap") then
+               ! There is no surface tracer for h2o_vap;
+               ! "h2o_ice" should be loaded instead
+               txt="h2o_ice"
+               write(*,*) 'phyetat0: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+             endif
+           ENDIF ! of IF (oldtracernames) THEN
+           ierr=NF_INQ_VARID(nid,txt,nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+             write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
+     &                  ' not found in file'
+             write(*,*) trim(txt), ' set to 0'
+             do ig=1,ngridmx
+               qsurf(ig,iq)=0.
+             end do
+             nqold=min(iq-1,nqold)
+           ELSE
+#ifdef NC_DOUBLE
+             ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+#else
+             ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+#endif
+             IF (ierr.NE.NF_NOERR) THEN
+               PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
+               CALL abort
+             ENDIF
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(qsurf(1:ngridmx,iq))
+           xmax = MAXVAL(qsurf(1:ngridmx,iq))
+           PRINT*,'tracer on surface <',trim(txt),'>:',xmin,xmax
+         ENDDO
+         if ((nqold.lt.nq).and.(nqold.ge.1)) then
+c        case when new tracer are added in addition to old ones
+             write(*,*)'qsurf 1 to ', nqold,'were already present'
+             write(*,*)'qsurf ', nqold+1,' to ', nqmx,'are new'
+            yes=' '
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+             write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
+             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+             read(*,fmt='(a)') yes
+            end do
+            if (yes.eq.'y') then
+              write(*,*) 'OK, let s reindex qsurf'
+                 do ig=1,ngridmx
+                    do iq=nqmx,nqmx-nqold+1,-1
+                       qsurf(ig,iq)=qsurf(ig,iq-nqmx+nqold)
+                    end do
+                    do iq=nqmx-nqold,1,-1
+                       qsurf(ig,iq)= 0.
+                    end do
+                 end do
+            end if
+         end if
+      ENDIF
+
+! Call to soil_settings, in order to read soil temperatures,
+! as well as thermal inertia and volumetric heat capacity
+
+      call soil_settings(nid,ngridmx,nsoil,tsurf,tsoil)
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physdem1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physdem1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physdem1.F	(revision 46)
@@ -0,0 +1,657 @@
+      subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
+     .                   phystep,day_ini,
+     .                   time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .                   airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
+
+      implicit none
+c-------------------------------------------------------------
+c
+c create physics (re-)start data file "restartfi.nc"
+c
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+c-----------------------------------------------------------------------
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "comdissnew.h"
+#include "logic.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "dimphys.h"
+#include"advtrac.h"
+#include"callkeys.h"
+c
+      INTEGER nid,iq
+      INTEGER, parameter :: ivap=1
+      REAL, parameter :: qsolmax= 150.0
+      character (len=*) :: filename
+      character (len=7) :: str7
+
+      REAL day_ini
+      INTEGER nsoil,nq
+      integer ierr,idim1,idim2,idim3,idim4,idim5,nvarid
+
+c
+      REAL phystep,time
+      REAL latfi(ngridmx), lonfi(ngridmx)
+!      REAL champhys(ngridmx)
+      REAL tsurf(ngridmx)
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+
+c
+
+!      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
+!      EXTERNAL exner_hyb , SSUM
+c
+#include "serre.h"
+#include "clesph0.h"
+#include "fxyprim.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+
+      real co2ice(ngridmx),tsoil(ngridmx,nsoil),emis(ngridmx)
+      real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
+      real airefi(ngridmx)
+      real alb(ngridmx),ith(ngridmx,nsoil)
+      real pzmea(ngridmx),pzstd(ngridmx)
+      real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
+      integer ig
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+! flag which identifies if we are using old tracer names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+! indexes of water vapour & water ice tracers (if any):
+      integer :: i_h2o_vap=0
+      integer :: i_h2o_ice=0
+c-----------------------------------------------------------------------
+
+      ! copy airefi(:) to area(:)
+      CALL SCOPY(ngridmx,airefi,1,area,1)
+      ! note: area() is defined in comgeomfi.h
+
+      DO ig=1,ngridmx
+         albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat.h
+         zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat.h
+         zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat.h
+         zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat.h
+         zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat.h
+         zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat.h
+      ENDDO
+
+      inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil.h
+c
+c  things to store in the physics start file:
+c
+      ierr = NF_CREATE(adjustl(filename),NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        WRITE(6,*)'physdem1: Problem creating file ',adjustl(filename)
+        write(6,*) NF_STRERROR(ierr)
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
+     .                       "Physics start file")
+c
+      ierr = NF_DEF_DIM (nid,"index",length,idim1)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining index dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining physical_points dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
+      if (ierr.ne.NF_NOERR) then
+      WRITE(6,*)'physdem1: Problem defining subsurface_layers dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+!      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
+      ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining nlayer+1 dimension'
+        write(6,*) NF_STRERROR(ierr)
+	call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining advected fields dimension'
+        WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
+        write(6,*) NF_STRERROR(ierr)
+      endif
+
+      ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
+
+c clear tab_cntrl(:) array
+      DO ierr = 1, length
+         tab_cntrl(ierr) = 0.0
+      ENDDO
+
+      write(*,*) "physdem1: ngridmx: ",ngridmx
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Fill control array tab_cntrl(:) with paramleters for this run
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Informations on the physics grid
+      tab_cntrl(1) = float(ngridmx)  ! number of nodes on physics grid
+      tab_cntrl(2) = float(nlayermx) ! number of atmospheric layers
+      tab_cntrl(3) = day_ini + int(time)         ! initial day 
+      tab_cntrl(4) = time -int(time)            ! initiale time of day
+
+c Informations about Mars, used by dynamics and physics
+      tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
+      tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
+      tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
+      tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
+      tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
+      tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
+
+      tab_cntrl(11) = phystep  ! time step in the physics
+      tab_cntrl(12) = 0.
+      tab_cntrl(13) = 0.
+
+c Informations about Mars, only for physics
+      tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
+      tab_cntrl(15) = periheli  ! min. Sun-Mars distance (Mkm) ~206.66
+      tab_cntrl(16) = aphelie   ! max. SUn-Mars distance (Mkm) ~249.22
+      tab_cntrl(17) = peri_day  ! date of perihelion (sols since N. spring)
+      tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
+
+c Boundary layer and turbulence
+      tab_cntrl(19) = z0        ! surface roughness (m) ~0.01
+      tab_cntrl(20) = lmixmin   ! mixing length ~100
+      tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
+
+c Optical properties of polar caps and ground emissivity
+      tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
+      tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
+      tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
+      tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
+      tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
+      tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
+      tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
+      tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
+      tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
+
+c dust aerosol properties
+      tab_cntrl(27) = tauvis      ! mean visible optical depth
+
+      tab_cntrl(28) = 0. 
+      tab_cntrl(29) = 0.
+      tab_cntrl(30) = 0.
+
+! Soil properties:
+      tab_cntrl(35) = volcapa ! soil volumetric heat capacity
+      
+c
+!      write(*,*) "physdem1: tab_cntrl():",tab_cntrl
+      
+      ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+         CALL abort
+      ENDIF
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to define controle'
+         CALL abort
+      ENDIF
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "Control parameters")
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to define controle title attribute'
+         CALL abort
+      ENDIF
+      ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to swich out of NetCDF define mode'
+         CALL abort
+      ENDIF
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to write controle data'
+         CALL abort
+      ENDIF
+
+! write mid-layer depths mlayer() !known from comsoil.h
+
+      ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"soildepth",NF_DOUBLE,1,idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"soildepth",NF_FLOAT,1,idim3,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+     .                        "Soil mid-layer depth")
+      ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
+     .                        "Longitudes of physics grid")
+      ierr = NF_ENDDEF(nid)
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
+     .                        "Latitudes of physics grid")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                        "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .                        "Geopotential at the surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 21,
+     .                        "Albedo of bare ground")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
+#endif
+
+c
+c   some data for Francois Lott's programs
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Relief: mean relief")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
+     .                        "Relief: standard deviation")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: sigma parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: gamma parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: theta parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
+#endif
+
+c Write the physical fields
+
+! CO2 Ice Cover
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
+     .                        "CO2 ice cover")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,co2ice)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,co2ice)
+#endif
+
+! Soil Thermal inertia
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"inertiedat",NF_DOUBLE,
+     &                   2,(/idim2,idim3/),nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"inertiedat",NF_FLOAT,
+     &                   2,(/idim2,idim3/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 20,
+     .                        "Soil thermal inertia")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
+#endif
+
+!  Surface temperature
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Surface temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsurf)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsurf)
+#endif
+
+! Soil temperature
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_DOUBLE,2,(/idim2,idim3/),nvarid)
+#else
+!      ierr = NF_DEF_VAR (nid, "tsoil", NF_FLOAT, 2, idim2,nvarid)
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_FLOAT,2,(/idim2,idim3/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+     .                        "Soil temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil)
+#endif
+
+c emissivity
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "emis", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
+     .                        "Surface emissivity")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,emis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,emis)
+#endif
+
+c planetary boundary layer
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 2,(/idim2,idim4/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "pbl wind variance")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q2)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,q2)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+        PRINT*, 'physdem1: Failed to write q2'
+        CALL abort
+      ENDIF
+
+c tracers
+
+! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+!                    qsurf02, ...)
+      count=0
+      do iq=1,nqmx
+        txt= " "
+        write(txt,'(a1,i2.2)')'q',iq
+        if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          count=count+1
+        endif
+      enddo
+      if (count.eq.nqmx) then
+        write(*,*) "physdem1:tracers seem to follow old naming ",
+     &             "convention (qsurf01,qsurf02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldtracernames=.true.
+        ! Moreover, if computing water cycle with ice, move surface ice
+        ! back to qsurf(nqmx)
+        IF (water) THEN
+          write(*,*)'physdem1: moving surface water ice to index ',nqmx
+          qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1)
+          qsurf(1:ngridmx,nqmx-1)=0
+        ENDIF
+      endif ! of if (count.eq.nqmx)
+
+      IF(nq.GE.1) THEN
+! preliminary stuff: look for water vapour & water ice tracers (if any)
+        if (.not.oldtracernames) then
+         do iq=1,nq
+           if (tnom(iq).eq."h2o_vap") then
+             i_h2o_vap=iq
+           endif
+           if (tnom(iq).eq."h2o_ice") then
+             i_h2o_ice=iq
+           endif
+         enddo ! of iq=1,nq
+         ! handle special case of only water vapour tracer (no ice)
+         if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
+          ! then the index of (surface) ice is i_h2o_vap
+          i_h2o_ice=i_h2o_vap
+         endif
+        endif ! of if (.not.oldtracernames) 
+
+         DO iq=1,nq
+           IF (oldtracernames) THEN
+             txt=" "
+             write(txt,'(a5,i2.2)')'qsurf',iq
+           ELSE
+             txt=tnom(iq)
+             ! Exception: there is no water vapour surface tracer
+             if (txt.eq."h2o_vap") then
+               write(*,*)"physdem1: skipping water vapour tracer"
+               if (i_h2o_ice.eq.i_h2o_vap) then
+               ! then there is no "water ice" tracer; but still
+               ! there is some water ice on the surface
+                 write(*,*)"          writting water ice instead"
+                 txt="h2o_ice"
+               else
+               ! there is a "water ice" tracer which has been / will be
+               ! delt with in due time
+                 cycle
+               endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
+             endif ! of if (txt.eq."h2o_vap")
+           ENDIF ! of IF (oldtracernames)
+
+           ierr=NF_REDEF(nid)
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+             CALL abort
+           ENDIF
+#ifdef NC_DOUBLE
+           ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,1,idim2,nvarid)
+#else
+           ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,1,idim2,nvarid)
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to define ',trim(txt)
+             CALL abort
+           ENDIF
+           ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     &                        "tracer on surface")
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to define ',trim(txt),
+     &               ' title attribute'
+             CALL abort
+           ENDIF
+           ierr=NF_ENDDEF(nid)
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to swich out of define mode'
+             CALL abort
+           ENDIF
+           
+#ifdef NC_DOUBLE
+            ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
+#else
+            ierr=NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to write ',trim(txt)
+             CALL abort
+           ENDIF
+         ENDDO ! of DO iq=1,nq
+      ENDIF ! of IF(nq.GE.1)
+
+c close file
+      ierr = NF_CLOSE(nid)
+
+      RETURN
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physiq.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physiq.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/physiq.F	(revision 46)
@@ -0,0 +1,1453 @@
+      SUBROUTINE physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,
+     $            pw,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Organisation of the physical parametrisations of the LMD 
+c   martian atmospheric general circulation model.
+c
+c   The GCM can be run without or with tracer transport
+c   depending on the value of Logical "tracer" in file  "callphys.def"
+c   Tracers may be water vapor, ice OR chemical species OR dust particles
+c
+c   SEE comments in initracer.F about numbering of tracer species...
+c
+c   It includes:
+c
+c      1. Initialization:
+c      1.1 First call initializations
+c      1.2 Initialization for every call to physiq
+c      1.2.5 Compute mean mass and cp, R and thermal conduction coeff.
+c      2. Compute radiative transfer tendencies
+c         (longwave and shortwave) for CO2 and aerosols.
+c      3. Gravity wave and subgrid scale topography drag :
+c      4. Vertical diffusion (turbulent mixing):
+c      5. Convective adjustment
+c      6. Condensation and sublimation of carbon dioxide.
+c      7.  TRACERS :
+c       7a. water and water ice
+c       7b. call for photochemistry when tracers are chemical species
+c       7c. other scheme for tracer (dust) transport (lifting, sedimentation)
+c       7d. updates (CO2 pressure variations, surface budget)
+c      8. Contribution to tendencies due to thermosphere
+c      9. Surface and sub-surface temperature calculations
+c     10. 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           
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c    ecri                  period (in dynamical timestep) to write output
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    nq                    Number of advected fields
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
+c    ptimestep             timestep (s)
+c    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
+c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
+c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
+c    pu(ngrid,nlayer)      u component of the wind (ms-1)
+c    pv(ngrid,nlayer)      v component of the wind (ms-1)
+c    pt(ngrid,nlayer)      Temperature (K)
+c    pq(ngrid,nlayer,nq)   Advected fields
+c    pudyn(ngrid,nlayer)    \ 
+c    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
+c    ptdyn(ngrid,nlayer)     / corresponding variables
+c    pqdyn(ngrid,nlayer,nq) /
+c    pw(ngrid,?)           vertical velocity
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx)        /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind) 
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+      REAL rnuclei(ngridmx,nlayermx)   ! Prescribed dust radius in each
+                                     !   layer (m)
+
+      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 -----------------
+
+
+      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, PARAMETER :: taufirstcall(ngridmx,naerkind) = 0.2
+                                     ! Estimated column dust optical depth at
+                                     ! firstcall
+      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 reff(ngridmx,nlayermx) ! effective dust radius (used if doubleq=T)
+      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 opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Ice absorption coefficient
+
+
+      REAL time_phys
+
+c=======================================================================
+
+c 1. Initialisation:
+c -----------------
+
+c  1.1   Initialisation only at first call
+c  ---------------------------------------
+      IF (firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+
+! Read netcdf initial physical parameters.
+         CALL phyetat0 ("startfi.nc",0,0,
+     &         nsoilmx,nq,
+     &         day_ini,time_phys,
+     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+         if (pday.ne.day_ini) then
+           write(*,*) "PHYSIQ: ERROR: bad synchronization between ",
+     &                "physics and dynamics"
+           write(*,*) "dynamics day: ",pday
+           write(*,*) "physics day:  ",day_ini
+           stop
+         endif
+
+         write (*,*) 'In physiq day_ini =', day_ini
+
+c        Initialize albedo and orbital calculation
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         CALL surfini(ngrid,co2ice,qsurf,albedo)
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c        initialize soil 
+c        ~~~~~~~~~~~~~~~
+         IF (callsoil) THEN
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         ELSE
+            PRINT*,'WARNING! Thermal conduction in the soil turned off'
+            DO ig=1,ngrid
+               capcal(ig)=1.e5
+               fluxgrd(ig)=0.
+            ENDDO
+         ENDIF
+         icount=1
+
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+c        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if(ngrid.ne.1) then
+           latvl1= 22.27 
+           lonvl1= -47.94 
+           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+     &              int(1.5+(lonvl1+180)*iim/360.)
+           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+         end if 
+
+c        Initialize thermospheric parameters
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if (callthermos) call param_read
+
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+                   
+      ENDIF        !  (end of "if firstcall")
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      igout=ngrid/2+1 
+
+
+      zday=pday+ptime ! compute time, in sols (and fraction thereof)
+
+c     Compute Solar Longitude (Ls) :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then
+         call solarlong(zday,zls)
+      else
+         call solarlong(float(day_ini),zls)
+      end if
+
+c     Compute geopotential at interlayers
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zzlay(ig,l)=pphi(ig,l)/g
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zzlev(ig,1)=0.
+         zzlev(ig,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
+      ENDDO
+      DO l=2,nlayer
+         DO ig=1,ngrid
+            z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO l=1,nlayer
+         DO ig=1,ngrid 
+            zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp
+            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    1.2.5 Compute mean mass, cp, and R
+c    --------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+c-----------------------------------------------------------------------
+c    2. Compute radiative tendencies :
+c------------------------------------
+
+
+      IF (callrad) THEN
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+c          Local Solar zenith angle
+c          ~~~~~~~~~~~~~~~~~~~~~~~~
+           CALL orbite(zls,dist_sol,declin)
+
+           IF(diurnal) THEN
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
+               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
+
+               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s         ztim1,ztim2,ztim3, mu0,fract)
+
+           ELSE
+               CALL mucorr(ngrid,declin, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+c          Call main radiative transfer scheme
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c          Transfer through CO2 (except NIR CO2 absorption)
+c            and aerosols (dust and water ice)
+
+c          Estimate the ice particle size distribution at firstcall:
+c          --------------------------------------------------------
+
+           IF (firstcall.AND.activice) THEN
+             CALL watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,taufirstcall,
+     &                rnuclei,rice,nuice)
+           ENDIF
+
+c          Radiative transfer
+c          ------------------
+
+           CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,rice,nuice)
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       mu0,fract,declin, zdtnirco2)
+           endif
+
+c          Radiative flux from the sky absorbed by the surface (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           DO ig=1,ngrid
+               fluxrad_sky(ig)=emis(ig)*fluxsurf_lw(ig)
+     $         +fluxsurf_sw(ig,1)*(1.-albedo(ig,1))
+     $         +fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
+           ENDDO
+
+
+c          Net atmospheric radiative heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           IF(callnlte) THEN
+              CALL blendrad(ngrid, nlayer, pplay,
+     &             zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+           ELSE
+              DO l=1,nlayer
+                 DO ig=1,ngrid
+                    dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
+     &                          +zdtnirco2(ig,l)
+                  ENDDO
+              ENDDO
+           ENDIF
+
+
+
+        ENDIF ! of if(mod(icount-1,iradia).eq.0)
+
+
+
+c    Transformation of the radiative tendencies:
+c    -------------------------------------------
+
+c          Net radiative surface flux (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+           DO ig=1,ngrid
+               zplanck(ig)=tsurf(ig)*tsurf(ig)
+               zplanck(ig)=emis(ig)*
+     $         stephan*zplanck(ig)*zplanck(ig)
+               fluxrad(ig)=fluxrad_sky(ig)-zplanck(ig)
+           ENDDO
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF ! of IF (callrad)
+
+c-----------------------------------------------------------------------
+c    3. Gravity wave and subgrid scale topography drag :
+c    -------------------------------------------------
+
+
+      IF(calllott)THEN
+
+        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,zdtgw,zdugw,zdvgw)
+ 
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            pdv(ig,l)=pdv(ig,l)+zdvgw(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdugw(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtgw(ig,l)
+          ENDDO
+        ENDDO
+      ENDIF
+
+c-----------------------------------------------------------------------
+c    4. Vertical diffusion (turbulent mixing):
+c    -----------------------------------------
+c
+      IF (calldifv) THEN
+
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+         
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdv(ig,l)=pdv(ig,l)+zdvdif(ig,l)
+               pdu(ig,l)=pdu(ig,l)+zdudif(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhdif(ig,l)*zpopsk(ig,l)
+
+               zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only
+
+            ENDDO
+         ENDDO
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(ig)
+         ENDDO
+
+         if (tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+           DO iq=1, nq
+              DO ig=1,ngrid
+                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
+              ENDDO
+           ENDDO
+         end if ! of if (tracer)
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+      ENDIF ! of IF (calldifv)
+
+
+c-----------------------------------------------------------------------
+c   5. Dry convective adjustment:
+c   -----------------------------
+
+      IF(calladj) THEN
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            ENDDO
+         ENDDO
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                pu,pv,zh,pq,
+     $                pdu,pdv,zdh,pdq,
+     $                zduadj,zdvadj,zdhadj,
+     $                zdqadj)
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdu(ig,l)=pdu(ig,l)+zduadj(ig,l)
+               pdv(ig,l)=pdv(ig,l)+zdvadj(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhadj(ig,l)*zpopsk(ig,l)
+
+               zdtadj(ig,l)=zdhadj(ig,l)*zpopsk(ig,l) ! for diagnostic only
+            ENDDO
+         ENDDO
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         end if
+      ENDIF ! of IF(calladj)
+
+c-----------------------------------------------------------------------
+c   6. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,tsurf,pt,
+     $              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,
+     $              co2ice,albedo,emis,
+     $              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,zdqc,
+     $	            fluxsurf_sw,zls) 
+
+         DO l=1,nlayer
+           DO ig=1,ngrid
+             pdt(ig,l)=pdt(ig,l)+zdtc(ig,l)
+             pdv(ig,l)=pdv(ig,l)+zdvc(ig,l)
+             pdu(ig,l)=pdu(ig,l)+zduc(ig,l)
+           ENDDO
+         ENDDO
+         DO ig=1,ngrid
+            zdtsurf(ig) = zdtsurf(ig) + zdtsurfc(ig)
+         ENDDO
+
+         IF (tracer) THEN
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         ENDIF ! of IF (tracer)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                rnuclei,rice,nuice)
+c          if (activice) then
+c Temperature variation due to latent heat release
+c          DO l=1,nlayer
+c            DO ig=1,ngrid
+c              pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+c            ENDDO
+c          ENDDO
+c          endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+c        --------------
+c        photochemistry :
+c        --------------
+         IF (photochem .or. thermochem) then
+          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     &      zzlay,zday,pq,pdq,rice,
+     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!NB: Photochemistry includes condensation of H2O2
+
+           ! increment values of tracers:
+           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
+                      ! tracers is zero anyways
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO ! of DO iq=1,nq
+           ! add condensation tendency for H2O2
+           if (igcm_h2o2.ne.0) then
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o2)=pdq(ig,l,igcm_h2o2)
+     &                                +zdqcloud(ig,l,igcm_h2o2)
+               ENDDO
+             ENDDO
+           endif
+
+           ! increment surface values of tracers:
+           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
+                      ! tracers is zero anyways
+             DO ig=1,ngrid
+               dqsurf(ig,iq)=dqsurf(ig,iq)+zdqschim(ig,iq)
+             ENDDO
+           ENDDO ! of DO iq=1,nq
+           ! add condensation tendency for H2O2
+           if (igcm_h2o2.ne.0) then
+             DO ig=1,ngrid
+               dqsurf(ig,igcm_h2o2)=dqsurf(ig,igcm_h2o2)
+     &                                +zdqscloud(ig,igcm_h2o2)
+             ENDDO
+           endif
+
+         END IF  ! of IF (photochem.or.thermochem)
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,pu,pv,pt, tsurf,q2,
+     &                zdqdev,zdqsdev)
+ 
+           if (dustbin.ge.1) then
+              do iq=1,nq
+                 DO l=1,nlayer
+                    DO ig=1,ngrid
+                       pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdev(ig,l,iq)
+                    ENDDO
+                 ENDDO
+              enddo
+              do iq=1,nq
+                 DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqsdev(ig,iq)
+                 ENDDO
+              enddo
+           endif  ! of if (dustbin.ge.1)
+
+         END IF ! of IF (callddevil)
+
+c        ------------- 
+c        Sedimentation :   acts also on water ice
+c        ------------- 
+         IF (sedimentation) THEN 
+           call zerophys(ngrid*nlayer*nq, zdqsed)
+           call zerophys(ngrid*nq, zdqssed)
+
+           if(doubleq) then
+            call callsedim2q(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           else
+            call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rnuclei, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           end if
+
+           DO iq=1, nq
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqsed(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO
+           DO iq=1, nq
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqssed(ig,iq)
+             ENDDO
+           ENDDO
+         END IF   ! of IF (sedimentation)
+
+c   7d. Updates
+c     ---------
+
+        DO iq=1, nq
+          DO ig=1,ngrid
+
+c       ---------------------------------
+c       Updating tracer budget on surface
+c       ---------------------------------
+            qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq)
+
+          ENDDO  ! (ig)
+        ENDDO    ! (iq)
+
+      endif !  of if (tracer) 
+
+
+c-----------------------------------------------------------------------
+c   8. THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(pplev,pplay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+     &     pt,pq,pu,pv,pdt,pdq,
+     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dtrad(ig,l)=dtrad(ig,l)+zdteuv(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtconduc(ig,l)
+     &                         +zdteuv(ig,l)
+            pdv(ig,l)=pdv(ig,l)+zdvmolvis(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdumolvis(ig,l)
+            DO iq=1, nq
+              pdq(ig,l,iq)=pdq(ig,l,iq)+zdqmoldiff(ig,l,iq)
+            ENDDO
+          ENDDO
+        ENDDO
+
+      endif ! of if (callthermos)
+
+c-----------------------------------------------------------------------
+c   9. Surface  and sub-surface soil temperature
+c-----------------------------------------------------------------------
+c
+c
+c   9.1 Increment Surface temperature:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      DO ig=1,ngrid
+         tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 
+      ENDDO
+
+c  Prescribe a cold trap at south pole (except at high obliquity !!)
+c  Temperature at the surface is set there to be the temperature
+c  corresponding to equilibrium temperature between phases of CO2
+
+      IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+         if (caps.and.(obliquit.lt.27.)) then
+           ! NB: Updated surface pressure, at grid point 'ngrid', is
+           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+         endif
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) in case of ground frost
+c       everywhere except on the north permanent cap and in regions
+c       covered by dry ice. 
+c              ALWAYS PLACE these lines after newcondens !!!
+c       -------------------------------------------------------------
+         do ig=1,ngrid
+           if ((co2ice(ig).eq.0).and.
+     &        (qsurf(ig,igcm_h2o_ice).gt.0.005)) then
+              albedo(ig,1)=0.45                                     
+              albedo(ig,2)=0.45                                     
+           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
+
+         IF(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+
+         if (tracer) then
+           if (water) then
+
+             call zerophys(ngrid,mtot)
+             call zerophys(ngrid,icetot)
+             call zerophys(ngrid,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
+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)-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))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+c        -----------------------------------------------------------------
+c        WSTATS: Saving statistics
+c        -----------------------------------------------------------------
+c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+c        which can later be used to make the statistic files of the run:
+c        "stats")          only possible in 3D runs !
+
+         
+         IF (callstats) THEN
+
+           call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
+           call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+           call wstats(ngrid,"co2ice","CO2 ice cover",
+     &                "kg.m-2",2,co2ice)
+           call wstats(ngrid,"fluxsurf_lw",
+     &                "Thermal IR radiative flux to surface","W.m-2",2,
+     &                fluxsurf_lw)
+           call wstats(ngrid,"fluxsurf_sw",
+     &                "Solar radiative flux to surface","W.m-2",2,
+     &                fluxsurf_sw_tot)
+           call wstats(ngrid,"fluxtop_lw",
+     &                "Thermal IR radiative flux to space","W.m-2",2,
+     &                fluxtop_lw)
+           call wstats(ngrid,"fluxtop_sw",
+     &                "Solar radiative flux to space","W.m-2",2,
+     &                fluxtop_sw_tot)
+           call wstats(ngrid,"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
+
+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) 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)
+           endif ! of if (doubleq)
+           
+           if (dustbin.gt.0) then
+             do iq=1,dustbin
+               call WRITEDIAGFI(ngridmx,noms(igcm_dustbin(iq)),
+     &              'mix. ratio','kg/kg',
+     &                         3,zq(1,1,igcm_dustbin(iq)))
+               call WRITEDIAGFI(ngridmx,
+     &             trim(noms(igcm_dustbin(iq)))//'_surf',
+     &             'qsurf','kg.m-2',2,qsurf(1,igcm_dustbin(iq)))
+             end do
+           endif ! of if (dustbin.gt.0)
+         end if  ! of if (tracer)
+
+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,' local tau =',tau(1,1)
+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')
+
+! Output in diagfi.nc (for testphys1d)
+         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+         call WRITEDIAGFI(ngridmx,'temp','Temperature',
+     &                       'K',1,zt)
+
+         if(tracer) then
+c           CALL writeg1d(ngrid,1,tau,'tau','SI')
+            do iq=1,nq
+c              CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+               call WRITEDIAGFI(ngridmx,trim(noms(iq)),
+     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+            end do
+         end if
+
+         zlocal(1)=-log(pplay(1,1)/pplev(1,1))* Rnew(1,1)*zt(1,1)/g
+
+         do l=2,nlayer-1
+            tmean=zt(1,l)
+            if(zt(1,l).ne.zt(1,l-1))
+     &        tmean=(zt(1,l)-zt(1,l-1))/log(zt(1,l)/zt(1,l-1))
+              zlocal(l)= zlocal(l-1)
+     &        -log(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+         enddo
+         zlocal(nlayer)= zlocal(nlayer-1)-
+     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/planete.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/planete.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/planete.h	(revision 46)
@@ -0,0 +1,14 @@
+c-----------------------------------------------------------------------
+c INCLUDE planet.h
+
+      COMMON/planet/aphelie,periheli,year_day,peri_day,
+     $       obliquit,
+     $       z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+      REAL aphelie,periheli,year_day,peri_day,
+     $     obliquit,
+     $     z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/profile.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/profile.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/profile.F	(revision 46)
@@ -0,0 +1,225 @@
+!      SUBROUTINE profile(unit,nlev,zkm,temp)
+      SUBROUTINE profile(nlev,zkm,temp)
+! to use  'getin'
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+c=======================================================================
+c     Subroutine utilisee dans le modele 1-D  "testphys1d"
+c     pour l'initialisation du profil atmospherique
+c=======================================================================
+c
+c   differents profils d'atmospheres. T=f(z)
+c   entree:
+c     nlev    nombre de niveaux
+c     zkm     alititudes en km
+c     ichoice choix de l'atmosphere:
+c             1 Temperature constante
+c             2 profil Savidjari
+c             3 Lindner (profil polaire)
+c             4 Inversion pour Francois
+c             5 Seiff (moyen)
+c             6 T constante + perturbation gauss (level) (christophe 10/98)
+c             7 T constante + perturbation gauss   (km)  (christophe 10/98)
+c             8 Lecture du profile dans un fichier ASCII (profile)
+c     tref    temperature de reference
+c     isin    ajout d'une perturbation (isin=1)
+c     pic     pic perturbation gauss pour ichoice = 6 ou 7
+c     largeur largeur de la perturbation gauss pour ichoice = 6 ou 7
+c     hauteur hauteur de la perturbation gauss pour ichoice = 6 ou 7
+c
+c   sortie:
+c     temp    temperatures en K
+c     
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+       INTEGER nlev
+       REAL zkm(nlev),temp(nlev)
+
+c   local:
+c   ------
+
+      INTEGER il,ichoice,nseiff,iseiff,isin,iter
+      REAL pi
+      PARAMETER(nseiff=37)
+      REAL tref,t1,t2,t3,ww
+      REAL tseiff(nseiff)
+      DATA tseiff/214.,213.8,213.4,212.4,209.3,205.,201.4,197.8,
+     $           194.6,191.4,188.2,185.2,182.5,180.,177.5,175,
+     $           172.5,170.,167.5,164.8,162.4,160.,158.,156.,
+     $           154.1,152.2,150.3,148.7,147.2,145.7,144.2,143.,
+     $           142.,141.,140,139.5,139./
+      REAL pic,largeur
+      REAL hauteur,tmp
+
+c-----------------------------------------------------------------------
+c   read input profile type:
+c--------------------------
+
+      ichoice=1 ! default value for ichoice
+      call getin("ichoice",ichoice)
+      tref=200 ! default value for tref
+      call getin("tref",tref)
+      isin=0 ! default value for isin (=0 means no perturbation)
+      call getin("isin",isin)
+      pic=26.522 ! default value for pic
+      call getin("pic",pic)
+      largeur=10 ! default value for largeur
+      call getin("largeur",largeur)
+      hauteur=30 ! default value for hauteur
+      call getin("hauteur",hauteur)
+
+c-----------------------------------------------------------------------
+c   ichoice=1 temperature constante:
+c   --------------------------------
+
+      IF(ichoice.EQ.1) THEN
+         DO il=1,nlev
+            temp(il)=tref
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=2 savidjari:
+c   --------------------
+
+      ELSE IF(ichoice.EQ.2) THEN
+         DO il=1,nlev
+            temp(il)=AMAX1(219.-2.5*zkm(il),140.)
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=3 Lindner:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.3) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.2.5) THEN
+               temp(il)=150.+30.*zkm(il)/2.5
+            ELSE IF(zkm(il).LT.5.) THEN
+               temp(il)=180.
+            ELSE
+               temp(il)=AMAX1(180.-2.*(zkm(il)-5.),130.)
+            ENDIF
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=4 Inversion pour Francois:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.4) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.20.) THEN
+               temp(il)=135.
+            ELSE
+               temp(il)=AMIN1(135.+5.*(zkm(il)-20.),200.)
+            ENDIF
+         ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=5 Seiff:
+c   ----------------
+
+      ELSE IF(ichoice.EQ.5) THEN
+	 DO il=1,nlev
+	    iseiff=INT(zkm(il)/2.)+1
+	    IF(iseiff.LT.nseiff-1) THEN
+	       temp(il)=tseiff(iseiff)+(zkm(il)-2.*(iseiff-1))*
+     $         (tseiff(iseiff+1)-tseiff(iseiff))/2.
+	    ELSE
+	       temp(il)=tseiff(nseiff)
+	    ENDIF
+	 ENDDO
+c IF(ichoice.EQ.6) THEN
+c	    DO iter=1,6
+c	    t2=temp(1)
+c	    t3=temp(2)
+c	    DO il=2,nlev-1
+c	       t1=t2
+c	       t2=t3
+c	       t3=temp(il+1)
+c	       ww=tanh(zkm(il)/20.)
+c	       ww=ww*ww*ww
+c	       temp(il)=t2+ww*.5*(t1-2.*t2+t3)
+c	    ENDDO
+c	    ENDDO
+c	 ENDIF
+
+c-----------------------------------------------------------------------
+c   ichoice=6 
+c   ---------
+
+      ELSE IF(ichoice.EQ.6) THEN
+      DO il=1,nlev
+        tmp=il-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp/largeur/largeur)
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=7
+c   ---------
+
+      ELSE IF(ichoice.EQ.7) THEN
+      DO il=1,nlev
+        tmp=zkm(il)-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp*4/largeur/largeur)
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=8
+c   ---------
+
+      ELSE IF(ichoice.GE.8) THEN
+      OPEN(11,file='profile',status='old',form='formatted',err=101)
+      DO il=1,nlev
+        READ (11,*) temp(il)
+      ENDDO
+
+      GOTO 201
+101   STOP'fichier profile inexistant'
+201   CONTINUE
+      CLOSE(10)
+
+c-----------------------------------------------------------------------
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   rajout eventuel d'une perturbation:
+c   -----------------------------------
+
+      IF(isin.EQ.1) THEN
+	 pi=2.*ASIN(1.)
+	 DO il=1,nlev
+c       if (nlev.EQ.501) then
+c         if (zkm(il).LE.70.5) then
+c       temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+c    s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c         endif
+c       else
+        temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+     s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c       endif
+	 ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   Ecriture du profil de temperature dans un fichier profile.out
+c   -------------------------------------------------------------
+
+
+      OPEN(12,file='profile.out',form='formatted')
+	  DO il=1,nlev
+	    write(12,*) temp(il)
+	  ENDDO
+      CLOSE(12)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/readtesassim.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/readtesassim.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/readtesassim.F90	(revision 46)
@@ -0,0 +1,291 @@
+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"
+   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
+     else
+       write(*,*) "readtesassim: wrong value for flag swrtype !"
+       stop
+     endif
+   endif ! of if (swrtype.eq.1)
+enddo
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scatter.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scatter.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scatter.F	(revision 46)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scopyi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scopyi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/scopyi.F	(revision 46)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil.F	(revision 46)
@@ -0,0 +1,166 @@
+      subroutine soil(ngrid,nsoil,firstcall,
+     &          therm_i,
+     &          timestep,tsurf,tsoil,
+     &          capcal,fluxgrd)
+      implicit none
+
+!-----------------------------------------------------------------------
+!  Author: Ehouarn Millour
+!
+!  Purpose: Compute soil temperature using an implict 1st order scheme
+!  
+!  Note: depths of layers and mid-layers, soil thermal inertia and 
+!        heat capacity are commons in comsoil.h
+!-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+
+#include"comsoil.h"
+
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      integer ngrid	! number of (horizontal) grid-points 
+      integer nsoil	! number of soil layers 
+      logical firstcall ! identifier for initialization call 
+      real therm_i(ngrid,nsoil) ! thermal inertia
+      real timestep	    ! time step
+      real tsurf(ngrid)   ! surface temperature
+! outputs:
+      real tsoil(ngrid,nsoil) ! soil (mid-layer) temperature
+      real capcal(ngrid) ! surface specific heat
+      real fluxgrd(ngrid) ! surface diffusive heat flux
+
+! local saved variables:
+!      real,save :: layer(ngridmx,nsoilmx)	! layer depth
+      real,save :: mthermdiff(ngridmx,0:nsoilmx-1) ! mid-layer thermal diffusivity
+      real,save :: thermdiff(ngridmx,nsoilmx-1) ! inter-layer thermal diffusivity
+      real,save :: coefq(0:nsoilmx-1)		! q_{k+1/2} coefficients
+      real,save :: coefd(ngridmx,nsoilmx-1)	! d_k coefficients
+      real,save :: alph(ngridmx,nsoilmx-1)	! alpha_k coefficients
+      real,save :: beta(ngridmx,nsoilmx-1)	! beta_k coefficients
+      real,save :: mu
+      
+! local variables:
+      integer ig,ik
+
+! 0. Initialisations and preprocessing step
+      if (firstcall) then
+      ! note: firstcall is set to .true. or .false. by the caller
+      !       and not changed by soil.F 
+! 0.1 Build mthermdiff(:), the mid-layer thermal diffusivities
+      do ig=1,ngrid
+        do ik=0,nsoil-1
+	  mthermdiff(ig,ik)=therm_i(ig,ik+1)*therm_i(ig,ik+1)/volcapa
+!	  write(*,*),'soil: ik: ',ik,' mthermdiff:',mthermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.2 Build thermdiff(:), the "interlayer" thermal diffusivities
+      do ig=1,ngrid
+        do ik=1,nsoil-1
+      thermdiff(ig,ik)=((layer(ik)-mlayer(ik-1))*mthermdiff(ig,ik)
+     &                +(mlayer(ik)-layer(ik))*mthermdiff(ig,ik-1))
+     &                    /(mlayer(ik)-mlayer(ik-1))
+!	write(*,*),'soil: ik: ',ik,' thermdiff:',thermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.3 Build coefficients mu, q_{k+1/2}, d_k, alpha_k and capcal
+      ! mu
+      mu=mlayer(0)/(mlayer(1)-mlayer(0))
+
+      ! q_{1/2}
+      coefq(0)=volcapa*layer(1)/timestep
+	! q_{k+1/2}
+        do ik=1,nsoil-1
+          coefq(ik)=volcapa*(layer(ik+1)-layer(ik))
+     &                 /timestep
+	enddo
+
+      do ig=1,ngrid
+	! d_k
+	do ik=1,nsoil-1
+	  coefd(ig,ik)=thermdiff(ig,ik)/(mlayer(ik)-mlayer(ik-1))
+	enddo
+	
+	! alph_{N-1}
+	alph(ig,nsoil-1)=coefd(ig,nsoil-1)/
+     &                  (coefq(nsoil-1)+coefd(ig,nsoil-1))
+        ! alph_k
+        do ik=nsoil-2,1,-1
+	  alph(ig,ik)=coefd(ig,ik)/(coefq(ik)+coefd(ig,ik+1)*
+     &                              (1.-alph(ig,ik+1))+coefd(ig,ik))
+	enddo
+
+        ! capcal
+! Cstar
+        capcal(ig)=volcapa*layer(1)+
+     &              (thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (timestep*(1.-alph(ig,1)))
+! Cs
+        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+!      write(*,*)'soil: ig=',ig,' capcal(ig)=',capcal(ig)
+      enddo ! of do ig=1,ngrid
+            
+      else ! of if (firstcall)
+
+!  1. Compute soil temperatures
+! First layer:
+      do ig=1,ngrid
+        tsoil(ig,1)=(tsurf(ig)+mu*beta(ig,1)*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))/
+     &              (1.+mu*(1.0-alph(ig,1))*
+     &               thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+! Other layers:
+      do ik=1,nsoil-1
+        do ig=1,ngrid
+	  tsoil(ig,ik+1)=alph(ig,ik)*tsoil(ig,ik)+beta(ig,ik)
+	enddo
+      enddo
+      
+      endif! of if (firstcall)
+
+!  2. Compute beta coefficients (preprocessing for next time step)
+! Bottom layer, beta_{N-1}
+      do ig=1,ngrid
+        beta(ig,nsoil-1)=coefq(nsoil-1)*tsoil(ig,nsoil)
+     &                   /(coefq(nsoil-1)+coefd(ig,nsoil-1))
+      enddo
+! Other layers
+      do ik=nsoil-2,1,-1
+        do ig=1,ngrid
+	  beta(ig,ik)=(coefq(ik)*tsoil(ig,ik+1)+
+     &                 coefd(ig,ik+1)*beta(ig,ik+1))/
+     &                 (coefq(ik)+coefd(ig,ik+1)*(1.0-alph(ig,ik+1))
+     &                  +coefd(ig,ik))
+	enddo
+      enddo
+
+!  3. Compute surface diffusive flux & calorific capacity
+      do ig=1,ngrid
+! Cstar
+!        capcal(ig)=volcapa(ig,1)*layer(ig,1)+
+!     &              (thermdiff(ig,1)/(mlayer(ig,1)-mlayer(ig,0)))*
+!     &              (timestep*(1.-alph(ig,1)))
+! Fstar
+        fluxgrd(ig)=(thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (beta(ig,1)+(alph(ig,1)-1.0)*tsoil(ig,1))
+
+!        mu=mlayer(ig,0)/(mlayer(ig,1)-mlayer(ig,0))
+!        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+!     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+! Fs
+        fluxgrd(ig)=fluxgrd(ig)+(capcal(ig)/timestep)*
+     &              (tsoil(ig,1)*(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+     &               -tsurf(ig)-mu*beta(ig,1)*
+     &                          thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil_settings.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil_settings.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/soil_settings.F	(revision 46)
@@ -0,0 +1,406 @@
+      subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil)
+      implicit none
+
+!======================================================================
+!  Author: Ehouarn Millour (07/2006)
+!
+!  Purpose: Read and/or initialise soil depths and properties
+!
+!  This subroutine reads from a NetCDF file (opened by the caller)
+!  of "startfi.nc" format.
+!  The various actions and variable read/initialized are:
+!  1. Check out the number of soil layers (in datafile); if it isn't equal
+!     to nsoil, then some interpolation will be required
+!     Also check if data in file "startfi.nc" is in older format (ie:
+!     thermal inertia was depth-independent; and there was no "depth"
+!     coordinate.
+!     Read/build layer (and midlayer) depths
+!  2. Read volumetric specific heat (or initialise it to default value)
+!  3. Read Thermal inertia
+!  4. Read soil temperatures
+!  5. Interpolate thermal inertia and temperature on the new grid, if
+!     necessary
+!======================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+
+#include "comsoil.h"
+#include "netcdf.inc"
+!======================================================================
+!  arguments
+!  ---------
+!  inputs:
+      integer nid	! Input Netcdf file ID 
+      integer ngrid	! # of horizontal grid points
+      integer nsoil	! # of soil layers
+      real tsurf(ngrid) ! surface temperature
+!  output:
+      real tsoil(ngridmx,nsoilmx)	! soil temperature
+
+!======================================================================
+! local variables:
+      integer ierr	! status (returned by NetCDF functions)
+      integer nvarid	! ID of NetCDF variable
+      integer dimid	! ID of NetCDF dimension
+      integer dimlen	! length along the "depth" dimension
+      integer ndims	! # of dimensions of read <inertiedat> data
+      integer ig,iloop	! loop counters
+
+      logical :: olddepthdef=.false. ! flag
+      logical :: interpol=.false. ! flag: true if interpolation will be requiered
+
+      ! to store "old" values
+      real,dimension(:),allocatable :: surfinertia !surface thermal inertia
+      real,dimension(:),allocatable :: oldmlayer
+      real,dimension(:,:),allocatable :: oldinertiedat
+      real,dimension(:,:),allocatable :: oldtsoil
+      
+      ! for interpolation
+      real,dimension(:),allocatable :: oldgrid
+      real,dimension(:),allocatable :: oldval
+      real,dimension(:),allocatable :: newval
+
+      real alpha,lay1 ! coefficients for building layers
+      real xmin,xmax ! to display min and max of a field
+
+      real,parameter :: default_volcapa=1.e6
+
+!======================================================================
+
+! 1. Depth coordinate
+! -------------------
+
+! 1.1 Start by reading how many layers of soil there are
+
+	ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
+	 call abort
+	endif
+
+	ierr=NF_INQ_DIMLEN(nid,dimid,dimlen)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
+     &             'length'
+	 call abort
+	endif
+
+        if (dimlen.ne.nsoil) then
+          write(*,*)'soil_settings: Interpolation of soil temperature ',
+     &              'and thermal inertia will be required!'
+	! if dimlen doesn't match nsoil, then interpolation of
+	! soil temperatures and thermal inertia will be requiered
+	  interpol=.true.
+	endif
+
+! 1.2 Find out the # of dimensions <inertiedat> was defined as using
+!     (in ye old days, thermal inertia was only given at the "surface")
+      ! Look for thermal inertia data
+      ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Field <inertiedat> not found!'
+         call abort
+      endif
+
+      ! Read the # of dimensions <inertidat> was defined as using
+      ierr=NF_INQ_VARNDIMS(nid,nvarid,ndims)
+      ! if (ndims.eq.1) then we have the "old 2D-surface" format
+
+! 1.3 Read depths values or set olddepthdef flag and values
+      if (ndims.eq.1) then ! we know that there is none
+        write(*,*)'soil_settings: no <soildepth> field expected'
+	write(*,*)'building one mimicking old definitions'
+        olddepthdef=.true.
+	interpol=.true.
+        ! allocate oldmlayer
+        if (.not.allocated(oldmlayer)) then
+          allocate(oldmlayer(dimlen),stat=ierr)
+          if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of oldmlayer!'
+            stop
+          endif
+        endif
+	do iloop=1,dimlen
+	  oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.)
+	enddo
+      else ! Look for depth 
+        ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+        if (ierr.ne.NF_NOERR) then
+          write(*,*)'soil_settings: Field <soildepth> not found!'
+	  call abort
+        endif
+        ! read <depth> coordinate
+        if (interpol) then !put values in oldmlayer
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldmlayer)
+#else
+           ierr = NF_GET_VAR_REAL(nid,nvarid,oldmlayer)
+#endif
+          if (ierr.ne.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <soildepth>'
+           call abort
+          endif
+        else ! put values in mlayer
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+           ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+          if (ierr.ne.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <soildepth>'
+           call abort
+          endif
+        endif !of if (interpol)
+      endif !of if (ndims.eq.1)
+
+! 1.4 Build mlayer(), if necessary
+      if (interpol) then
+      ! default mlayer distribution, following a power law:
+      !  mlayer(k)=lay1*alpha**(k-1/2)
+        lay1=2.e-4
+	alpha=2
+        do iloop=0,nsoil-1
+	  mlayer(iloop)=lay1*(alpha**(iloop-0.5))
+	enddo
+      endif
+
+! 1.5 Build layer(); following the same law as mlayer()
+      ! Assuming layer distribution follows mid-layer law:
+      ! layer(k)=lay1*alpha**(k-1)
+      lay1=sqrt(mlayer(0)*mlayer(1))
+      alpha=mlayer(1)/mlayer(0)
+      do iloop=1,nsoil
+        layer(iloop)=lay1*(alpha**(iloop-1))
+      enddo
+
+! 2. Volumetric heat capacity (note: it is declared in comsoil.h)
+! ---------------------------
+! "volcapa" is (so far) 0D and written in "controle" table of startfi file 
+! volcapa is read or set when "controle" is read (see tabfi.F)
+! Just in case, we check here that it is not zero. If it is, we
+! set it to "default_volcapa"
+
+      if (volcapa.le.0.0) then
+        write(*,*)'soil_settings: Warning, volcapa = ',volcapa
+	write(*,*)'               That doesn t seem right'
+        write(*,*)'        Initializing Volumetric heat capacity to ',
+     &             default_volcapa
+	volcapa=default_volcapa
+      endif
+! Look for it
+!      ierr=NF_INQ_VARID(nid,"volcapa",nvarid)
+!      if (ierr.NE.NF_NOERR) then
+!         write(*,*)'soil_settings: Field <volcapa> not found!'
+!         write(*,*)'Initializing Volumetric heat capacity to ',
+!     &             default_volcapa
+!         volcapa=default_volcapa
+!      else
+!#ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid,nvarid,volcapa)
+!#else
+!       ierr = NF_GET_VAR_REAL(nid,nvarid,volcapa)
+!#endif
+!        if (ierr.ne.NF_NOERR) then
+!	  write(*,*)'soil_settings: Problem while reading <volcapa>'
+!         call abort
+!	endif
+!      endif
+
+! 3. Thermal inertia (note: it is declared in comsoil.h)
+! ------------------
+
+! 3.1 Look (again) for thermal inertia data (to reset nvarid)
+      ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Field <inertiedat> not found!'
+         call abort
+      endif
+
+! 3.2 Knowing the # of dimensions <inertidat> was defined as using,
+!     read/build thermal inertia
+
+      if (ndims.eq.1) then ! "old 2D-surface" format
+       write(*,*)'soil_settings: Thermal inertia is only given as surfac
+     &e data!'
+       ! Read Surface thermal inertia
+       allocate(surfinertia(ngrid))
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, surfinertia)
+#else
+       ierr = NF_GET_VAR_REAL(nid, nvarid, surfinertia)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       
+       write(*,*)' => Building soil thermal inertia (using reference sur
+     &face thermal inertia)'
+       do iloop=1,nsoil
+         inertiedat(:,iloop)=surfinertia(:)
+       enddo
+       deallocate(surfinertia)
+
+      else ! "3D surface+depth" format
+       if (interpol) then ! put values in oldinertiedat
+         if (.not.allocated(oldinertiedat)) then
+           allocate(oldinertiedat(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of ',
+     &                 'oldinertiedat!'
+            stop
+           endif
+         endif
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldinertiedat)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,oldinertiedat)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       else ! put values in therm_i
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedat)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedat)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       endif ! of if (interpol)
+      endif ! of if (ndims.eq.1)
+      
+! 4. Read soil temperatures
+! -------------------------
+
+      ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*)'soil_settings: Field <tsoil> not found!'
+	write(*,*)' => Building <tsoil> from surface values <tsurf>'
+	do iloop=1,nsoil
+	  tsoil(:,iloop)=tsurf(:)
+	enddo
+      else ! <tsoil> found
+       if (interpol) then ! put values in oldtsoil
+         if (.not.allocated(oldtsoil)) then
+           allocate(oldtsoil(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+             write(*,*) 'soil_settings: failed allocation of ',
+     &                  'oldtsoil!'
+             stop
+           endif
+         endif
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VAR_DOUBLE(nid,nvarid,oldtsoil)
+#else
+        ierr=NF_GET_VAR_REAL(nid,nvarid,oldtsoil)
+#endif
+        if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+	 call abort
+	endif
+       else ! put values in tsoil
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VAR_DOUBLE(nid,nvarid,tsoil)
+#else
+        ierr=NF_GET_VAR_REAL(nid,nvarid,tsoil)
+#endif
+        if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+	 call abort
+	endif
+       endif ! of if (interpol) 
+      endif
+
+! 5. If necessary, interpolate soil temperatures and thermal inertias
+! -------------------------------------------------------------------
+
+      if (olddepthdef) then
+      ! tsoil needs to be interpolated, but not therm_i
+        allocate(oldgrid(dimlen+1))
+        allocate(oldval(dimlen+1))
+	allocate(newval(nsoil))
+
+        do ig=1,ngrid
+	  ! copy values
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! build vertical coordinate
+	  oldgrid(1)=0. ! ground
+	  oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)*
+     &                (inertiedat(ig,1)/volcapa)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in tsoil
+	  tsoil(ig,:)=newval(:)
+	enddo
+
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	interpol=.false. ! no need for interpolation any more      
+      endif !of if (olddepthdef)
+
+      if (interpol) then
+      write(*,*)'soil_settings: Vertical interpolation along new grid'
+      ! interpolate soil temperatures and thermal inertias
+        if (.not.allocated(oldgrid)) then
+          allocate(oldgrid(dimlen+1))
+          allocate(oldval(dimlen+1))
+	  allocate(newval(nsoil))
+        endif
+
+      ! thermal inertia
+        do ig=1,ngrid
+	  ! copy data
+	  oldval(1:dimlen)=oldinertiedat(ig,dimlen)
+	  ! interpolate
+	  call interp_line(oldmlayer,oldval,dimlen,mlayer,newval,nsoil)
+	  !copy result in inertiedat
+	  inertiedat(ig,:)=newval(:)
+	enddo
+        
+      ! soil temperature
+        ! vertical coordinate
+	oldgrid(1)=0.0
+	oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)
+        do ig=1,ngrid
+	  ! data
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in inertiedat
+	  tsoil(ig,:)=newval(:)
+	enddo
+	
+	!cleanup
+        deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	deallocate(oldinertiedat)
+	deallocate(oldtsoil)
+      endif ! of if (interpol)
+      
+! 6. Report min and max values of soil temperatures and thermal inertias
+! ----------------------------------------------------------------------
+
+      write(*,*)
+      write(*,*)'Soil volumetric heat capacity:',volcapa
+
+      xmin = MINVAL(inertiedat)
+      xmax = MAXVAL(inertiedat)
+      write(*,*)'Soil thermal inertia <inertiedat>:',xmin,xmax
+
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(tsoil)
+      xmax = MAXVAL(tsoil)
+      write(*,*)'Soil temperature <tsoil>:',xmin,xmax
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solang.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solang.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solang.F	(revision 46)
@@ -0,0 +1,114 @@
+      subroutine solang ( kgrid,psilon,pcolon,psilat,pcolat,
+     &                    ptim1,ptim2,ptim3,pmu0,pfract )
+      IMPLICIT NONE
+
+C
+C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
+C
+C     PURPOSE.
+C     --------
+C          CALCULATES THE SOLAR ANGLE FOR ALL THE POINTS OF THE GRID
+C
+C**   INTERFACE.
+C     ----------
+C      SUBROUTINE SOLANG ( KGRID )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS  ===
+C
+C PSILON(KGRID)   : SINUS OF THE LONGITUDE
+C PCOLON(KGRID)   : COSINUS OF THE LONGITUDE
+C PSILAT(KGRID)   : SINUS OF THE LATITUDE
+C PCOLAT(KGRID)   : COSINUS OF THE LATITUDE
+C PTIM1           : SIN(DECLI)
+C PTIM2           : COS(DECLI)*COS(TIME)
+C PTIM3           : SIN(DECLI)*SIN(TIME)
+C
+C     ==== OUTPUTS ===
+C
+C PMU0 (KGRID)    : SOLAR ANGLE
+C PFRACT(KGRID)   : DAY FRACTION OF THE TIME INTERVAL
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C         NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C         RADIATIVE PROCESSES IN METEOROLOGIE AND CLIMATOLOGIE
+C         PALTRIDGE AND PLATT
+C
+C     AUTHOR.
+C     -------
+C        FREDERIC HOURDIN
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL :90-01-14
+C                  92-02-14 CALCULATIONS DONE THE ENTIER GRID (J.Polcher)
+C-----------------------------------------------------------------------
+C
+C     ------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+C
+C*      0.1   ARGUMENTS
+C             ---------
+C
+      INTEGER kgrid
+      REAL ptim1,ptim2,ptim3
+      REAL psilon(kgrid),pcolon(kgrid),pmu0(kgrid),pfract(kgrid)
+      REAL psilat(kgrid), pcolat(kgrid)
+C
+      INTEGER jl
+      REAL ztim1,ztim2,ztim3
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C
+C------------------------------------------------------------------------
+C
+C*     1.     INITIALISATION
+C             --------------
+C
+ 100  CONTINUE
+C
+      DO jl=1,kgrid
+        pmu0(jl)=0.
+        pfract(jl)=0.
+      ENDDO
+C
+C*     1.1     COMPUTATION OF THE SOLAR ANGLE
+C              ------------------------------
+C
+      DO jl=1,kgrid
+        ztim1=psilat(jl)*ptim1
+        ztim2=pcolat(jl)*ptim2
+        ztim3=pcolat(jl)*ptim3
+        pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
+      ENDDO
+C
+C*     1.2      DISTINCTION BETWEEN DAY AND NIGHT
+C               ---------------------------------
+C
+      DO jl=1,kgrid
+        IF (pmu0(jl).gt.0.) THEN
+          pfract(jl)=1.
+c       pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
+      ELSE
+c       pmu0(jl)=0.
+        pfract(jl)=0.
+        ENDIF
+      ENDDO
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solarlong.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solarlong.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/solarlong.F	(revision 46)
@@ -0,0 +1,107 @@
+      SUBROUTINE solarlong(pday,psollong)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c      Calcul de la distance soleil-planete et de la declinaison
+c   en fonction du jour de l'annee.
+c
+c
+c   Methode:
+c   --------
+c
+c      Calcul complet de l'elipse
+c
+c   Interface:
+c   ----------
+c
+c      Uncommon comprenant les parametres orbitaux.
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
+c   lwrite        clef logique pour sorties de controle
+c
+c   Output:
+c   -------
+c   pdist_sol     distance entre le soleil et la planete
+c                 ( en unite astronomique pour utiliser la constante 
+c                  solaire terrestre 1370 Wm-2 )
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,psollong
+      LOGICAL lwrite
+
+c Local:
+c ------
+
+      REAL zanom,xref,zx0,zdx,zteta,zz
+      INTEGER iter
+
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c   Initialisation eventuelle:
+      if(.not.unitastr.gt.1.e-4) then
+         call iniorbit(249.22,206.66,669.,485.,25.2)
+      endif
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(pday-peri_day)/year_day
+      pi=2.*asin(1.)
+      zanom=2.*pi*(zz-nint(zz))
+      xref=abs(zanom)
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
+c  methode de Newton
+
+      zx0=xref+e_elips*sin(xref)
+      DO 110 iter=1,10
+         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-7)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+
+c zteta est la longitude solaire
+
+      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+
+      psollong=zteta-timeperi
+
+      IF(psollong.LT.0.) psollong=psollong+2.*pi
+      IF(psollong.GT.2.*pi) psollong=psollong-2.*pi
+c-----------------------------------------------------------------------
+c   sorties eventuelles:
+c   ---------------------
+
+c     IF (lwrite) THEN
+c        PRINT*,'jour de l"annee   :',pday
+c        PRINT*,'distance au soleil (en unite astronomique) :',pdist_sol
+c        PRINT*,'declinaison (en degres) :',pdecli*180./pi
+c     ENDIF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/statto.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/statto.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/statto.h	(revision 46)
@@ -0,0 +1,34 @@
+
+!  statto:
+!     This include file controls the production of statistics.
+!     Some variables could be set in a namelist, but it is easier to
+!     do it here since arrays can then be dimensioned using parameters
+!     and values shouldn't have to change too often.   SRL
+
+!     Calculate stats every istats physics timesteps, starting at first
+!     call.  If istats=0 then don't do statistics at all.  Check value
+!     if number of physics timesteps changes.
+	integer istats
+
+!     Calculate itime independent sums and sums of squares,
+!     example, istat=1,istime=1 gives a single time mean
+	integer, parameter :: istime=12
+
+!     Number of 2D and 3D variables on which to do statistics.
+	integer n2dvar, n3dvar
+	parameter (n2dvar = 8, n3dvar = 5)
+
+!     Units for writing stats header and data
+	integer usdata
+
+!     count tab to know the variable record
+        integer count(istime)
+
+!     Record of the number of stores made for each time.
+	integer nstore(istime)
+
+! Size of the "controle" array
+        integer, parameter :: cntrlsize=15
+
+!       common /sttcom/ dummy,nstore,istats,usdata
+        common /sttcom/ nstore,istats,usdata,count
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/suaer.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/suaer.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/suaer.F90	(revision 46)
@@ -0,0 +1,431 @@
+SUBROUTINE suaer
+IMPLICIT NONE
+!==================================================================
+!     Purpose.
+!     --------
+!     initialize yomaer, the common that contains the
+!     radiative characteristics of the aerosols
+!     
+!     AUTHORS.
+!     -------- 
+!     Richard Fournier (1996) Francois Forget (1996)
+!     Frederic Hourdin
+!     Jean-jacques morcrette *ECMWF*
+!     MODIF Francois Forget (2000)
+!     MODIF Franck Montmessin (add water ice)
+!     MODIF J.-B. Madeleine 2008W27
+!       - Optical properties read in ASCII files
+!       - Add varying radius of the particules
+!
+!    Summary.
+!    --------
+!
+!    Read the optical properties -> Mean  -> Variable assignment
+!                  (ASCII files)                  (see yomaer.h)
+!    wvl(nwvl)                      longsun
+!    ep(nwvl)                       epav     QVISsQREF(nsun)
+!    omeg(nwvl)                     omegav   omegavis(nsun)
+!    gfactor(nwvl)                  gav      gvis(nsun)
+!    
+!==================================================================
+
+! Includes:
+
+#include "callkeys.h"
+#include "datafile.h"
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"     
+#include "yomaer.h"
+
+! Optical properties (read in external ASCII files)
+INTEGER          :: nwvl     ! Number of wavelengths in
+                             ! the domain (VIS or IR)
+REAL, DIMENSION(:),&
+  ALLOCATABLE, SAVE :: wvl       ! Wavelength axis
+REAL, DIMENSION(:),&
+  ALLOCATABLE, SAVE :: radiusdyn ! Particle size axis
+
+REAL, DIMENSION(:,:),&
+  ALLOCATABLE, SAVE :: ep,&    ! Extinction coefficient Qext
+                       omeg,&  ! Single Scattering Albedo
+                       gfactor ! Assymetry Factor
+
+! Local variables:
+
+INTEGER :: iaer                ! Aerosol index
+INTEGER :: idomain             ! Domain index (1=VIS,2=IR)
+INTEGER :: iir                 ! IR channel index
+                               ! iir=1: 15um CO2 bands
+                               ! iir=2 : CO2 band wings
+                               ! iir=3 : 9 um band
+                               ! iir=4 : Far IR
+INTEGER :: isun                ! Solar band index
+INTEGER :: isize               ! Particle size index
+INTEGER :: jfile               ! ASCII file scan index
+INTEGER :: file_unit = 60
+LOGICAL :: file_ok, endwhile
+CHARACTER(LEN=132) :: scanline ! ASCII file scanning line
+
+! I/O  of "aerave" (subroutine averaging spectrally
+!   sing.scat.parameters)
+
+REAL tsun            ! Sun brightness temperature (for SW)
+REAL tsol            ! Surface reference brightness temp (LW)
+REAL longref         ! reference wavelengths
+REAL longsun(nsun+1) ! solar band boundaries
+REAL longir(nir+1)   ! IR band boundaries
+REAL epref           ! reference extinction ep
+                     ! at wavelength "longref"
+REAL epav(nir)       ! average ep
+                     ! (= <Qext>/Qext(longref) if epref=1)
+REAL omegav(nir)     ! Average sing.scat.albedo
+REAL gav(nir)        ! Average assymetry parameter
+
+! Local saved variables:
+
+CHARACTER(LEN=30), DIMENSION(naerkind,2), SAVE :: file_id
+!---- Please indicate the names of the optical property files below
+!     Please also choose the reference wavelengths of each aerosol
+!       naerkind=1, visible range:
+!       file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff
+       file_id(1,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM
+!       file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE
+!       file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
+!        file_id(1,1) = 'optprop_dustvis.dat'        !Clancy-Lee
+!       naerkind=1, infrared:
+!       file_id(1,2) = 'optprop_dustir_TM_n50.dat'  !M.Wolff
+       file_id(1,2) = 'optprop_dustir_TM.dat'      !M.Wolff
+!       file_id(1,2) = 'optprop_dustir_MW-MIE.dat'  !M.Wolff MIE
+!        file_id(1,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
+!       naerkind=1, visible range:
+        longrefvis(1)=0.67E-6
+!                     For dust: change readtesassim accordingly;
+!       naerkind=1, infrared:
+        longrefir(1)=9.3E-6
+      IF (activice) THEN
+!       naerkind=2, visible range:
+        file_id(2,1) = 'optprop_icevis_n30.dat'
+!       file_id(2,1) = 'optprop_icevis.dat'
+!       naerkind=2, infrared:
+        file_id(2,2) = 'optprop_iceir_n30.dat'
+!       file_id(2,2) = 'optprop_iceir.dat'
+!       naerkind=2, visible range:
+        longrefvis(2)=1.5E-6  ! 1.5um OMEGA/MEx
+!       naerkind=2, infrared:
+        longrefir(2)=12.1E-6  ! 825cm-1 TES/MGS
+      ENDIF
+!------------------------------------------------------------------
+
+! Initializations:
+
+call zerophys(nsizemax*2*naerkind,radiustab)
+
+call zerophys(nsizemax*naerkind*nsun,gvis)
+call zerophys(nsizemax*naerkind*nsun,omegavis)
+call zerophys(nsizemax*naerkind*nsun,QVISsQREF)
+
+call zerophys(nsizemax*naerkind*nir,gIR)
+call zerophys(nsizemax*naerkind*nir,omegaIR)
+call zerophys(nsizemax*naerkind*nir,QIRsQREF)
+
+call zerophys(nsizemax*naerkind,QREFvis)
+call zerophys(nsizemax*naerkind,QREFir)
+call zerophys(nsizemax*naerkind,omegaREFvis)
+call zerophys(nsizemax*naerkind,omegaREFir)
+
+DO iaer = 1, naerkind ! Loop on aerosol kind
+  DO idomain = 1, 2   ! Loop on radiation domain (VIS or IR)
+!==================================================================
+! 1. READ OPTICAL PROPERTIES
+!==================================================================
+
+!       1.1 Open the ASCII file
+
+INQUIRE(FILE=datafile(1:LEN_TRIM(datafile))//&
+  '/'//file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+  EXIST=file_ok)
+IF(.NOT.file_ok) THEN
+  write(*,*)'Problem opening ',&
+    file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain)))
+  write(*,*)'It should be in: ',&
+    datafile(1:LEN_TRIM(datafile))
+  write(*,*)'1) You can change this directory address in '
+  write(*,*)' file phymars/datafile.h'
+  write(*,*)'2) If ',&
+    file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+    ' is a LMD reference datafile, it'
+  write(*,*)' can be obtained online on:'
+  write(*,*)' http://www.lmd.jussieu.fr/',&
+    '~forget/datagcm/datafile'
+  write(*,*)'3) If the name of the file is wrong, you can'
+  write(*,*)' change it in file phymars/suaer.F90. Just'
+  write(*,*)' modify the variable called file_id.'
+  CALL ABORT 
+ENDIF
+OPEN(UNIT=file_unit,&
+  FILE=datafile(1:LEN_TRIM(datafile))//&
+  '/'//file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+  FORM='formatted')
+
+!       1.2 Allocate the optical property table
+
+jfile = 1
+endwhile = .false.
+DO WHILE (.NOT.endwhile)
+  READ(file_unit,*) scanline
+  IF ((scanline(1:1) .ne. '#').and.&
+    (scanline(1:1) .ne. ' ')) THEN
+    BACKSPACE(file_unit)
+    reading1_seq: SELECT CASE (jfile) ! ====================
+    CASE(1) reading1_seq ! nwvl ----------------------------
+        read(file_unit,*) nwvl
+        jfile = jfile+1
+    CASE(2) reading1_seq ! nsize ---------------------------
+        read(file_unit,*) nsize(iaer,idomain)
+        endwhile = .true.
+    CASE DEFAULT reading1_seq ! ---------------------------- 
+        WRITE(*,*) 'readoptprop: ',& 
+          'Error while loading optical properties.' 
+        CALL ABORT 
+    END SELECT reading1_seq ! ==============================
+  ENDIF
+ENDDO
+
+ALLOCATE(wvl(nwvl))                            ! wvl
+ALLOCATE(radiusdyn(nsize(iaer,idomain)))       ! radiusdyn
+ALLOCATE(ep(nwvl,nsize(iaer,idomain)))         ! ep
+ALLOCATE(omeg(nwvl,nsize(iaer,idomain)))       ! omeg 
+ALLOCATE(gfactor(nwvl,nsize(iaer,idomain)))    ! g
+
+!       1.3 Read the data
+
+jfile = 1
+endwhile = .false.
+DO WHILE (.NOT.endwhile)
+   READ(file_unit,*) scanline
+  IF ((scanline(1:1) .ne. '#').and.&
+    (scanline(1:1) .ne. ' ')) THEN
+    BACKSPACE(file_unit)
+    reading2_seq: SELECT CASE (jfile) ! ====================
+    CASE(1) reading2_seq ! wvl -----------------------------
+        read(file_unit,*) wvl
+        jfile = jfile+1
+    CASE(2) reading2_seq ! radiusdyn -----------------------
+        read(file_unit,*) radiusdyn
+        jfile = jfile+1
+    CASE(3) reading2_seq ! ep ------------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) ep(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        jfile = jfile+1
+    CASE(4) reading2_seq ! omeg ----------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) omeg(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        jfile = jfile+1
+    CASE(5) reading2_seq ! gfactor -------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) gfactor(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        endwhile = .true.
+    CASE DEFAULT reading2_seq ! ----------------------------
+        WRITE(*,*) 'suaer.F90: ',&
+          'Error while loading optical properties.'
+        CALL ABORT
+    END SELECT reading2_seq ! ==============================
+  ENDIF
+ENDDO
+
+!       1.4 Close the file
+
+CLOSE(file_unit)
+
+!==================================================================
+! 2. AVERAGED PROPERTIES AND VARIABLE ASSIGNMENTS
+!==================================================================
+domain: SELECT CASE (idomain)
+!==================================================================
+CASE(1) domain !                   VISIBLE DOMAIN (idomain=1)
+!==================================================================
+
+! 2.1 Parameters
+  tsun=6000.E+0
+  longsun(1)=long1vis
+  longsun(2)=long2vis
+  longsun(3)=long3vis
+  longref=longrefvis(iaer)
+  epref=1.E+0
+
+DO isize=1,nsize(iaer,idomain)
+! ------------------------------------------------
+! 2.2 Save the particle sizes
+  radiustab(iaer,idomain,isize)=radiusdyn(isize)
+! 2.3 Averaged optical properties (GCM channels)
+! Notice: Aerave also computes the extinction coefficient and
+!   single scattering albedo at reference wavelength
+!   (called QREFvis and OMEGAREFvis, same in the IR,
+!   and not epref, which is a different parameter);
+!   Reference wavelengths are defined for each aerosol in
+!   dimradmars.h.
+
+  CALL aerave ( nwvl,&
+       wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+       longref,epref,tsun,&
+       nsun,longsun, epav,omegav,gav,&
+       QREFvis(iaer,isize),omegaREFvis(iaer,isize) )
+! 2.4 Variable assignements (declared by yomaer.h)
+  DO isun=1,nsun
+    QVISsQREF(isun,iaer,isize)=epav(isun)
+    gvis(isun,iaer,isize)=gav(isun)
+    omegavis(isun,iaer,isize)=omegav(isun)
+  END DO
+! 2.5 Output display
+  WRITE(*,*) 'Les donnees spectrales :'
+  WRITE(*,*) 'Solaire (SW) ---->'
+  WRITE(*,*) 'Aerosol number: ', iaer
+  WRITE(*,*) 'Rayon aerosol: ', radiustab(iaer,idomain,isize)
+  WRITE(*,*) '<Qext>/Qext(longrefvis) ; omega ; g'
+  DO isun=1,nsun
+    WRITE(*,*) QVISsQREF(isun,iaer,isize),&
+         omegavis(isun,iaer,isize),&
+         gvis(isun,iaer,isize)
+  ENDDO
+  WRITE(*,*) 'QREFvis(',iaer,isize,') = ',QREFvis(iaer,isize)
+  WRITE(*,*) 'omegaREFvis(',iaer,isize,') = ',&
+                                      omegaREFvis(iaer,isize)
+! ------------------------------------------------
+ENDDO
+
+!==================================================================
+CASE(2) domain !                  INFRARED DOMAIN (idomain=2)
+!==================================================================
+
+DO isize=1,nsize(iaer,idomain) ! ----------------------------------
+
+! 2.1 solsir is not used anymore; division of Qext(IR) by solsir
+!     has to be done in the input ASCII files (if necessary).
+
+! 2.2 Save the particle sizes
+  radiustab(iaer,idomain,isize)=radiusdyn(isize)
+
+! 2.3 Parameters
+
+  tsol=215.D+0
+  longir(1)=long1ir
+  longir(2)=long1co2
+  longir(3)=long2co2
+  longir(4)=long2ir
+  longref=longrefir(iaer)
+  epref=1.E+0
+
+! 2.4 Averaged optical properties (GCM channels)
+!           epav is <QIR>/Qext(longrefir) since epref=1
+! Notice: Aerave also Computes the extinction coefficient at
+!   reference wavelength (called QREFvis or QREFir,
+!   and not epref, which is a different parameter);
+!   Reference wavelengths are defined for each aerosol in
+!   dimradmars.h.
+
+  CALL aerave ( nwvl,&
+       wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+       longref,epref,tsol,&
+       nir-1,longir,epav,omegav,gav,&
+       QREFir(iaer,isize),omegaREFir(iaer,isize) )
+  WRITE(*,*) 'QREFir(',iaer,isize,') = ',QREFir(iaer,isize)
+  WRITE(*,*) 'omegaREFir(',iaer,isize,') = ',&
+                                      omegaREFir(iaer,isize)
+
+! 2.5 Computing  <QIR>/Qext(longrefvis)
+
+  DO iir=1,4
+    WRITE(*,*) 'QIRsQREFir Channel ',iir,': ',epav(iir)
+    epav(iir)=  epav(iir) * QREFir(iaer,isize) / &
+                            QREFvis(iaer,isize)
+  ENDDO
+  WRITE(*,*) 'Aerosol number', iaer
+  WRITE(*,*) 'Particle size: ',radiustab(iaer,idomain,isize)
+  WRITE(*,*) 'Rapport Solaire/IR:',&
+             QREFvis(iaer,isize) / QREFir(iaer,isize)
+
+! 2.6 Variable assignements
+!           (variables are declared by yomaer.h)
+
+!         Single scattering properties
+!           in each of the "nir" bands
+!           (cf. dimradmars.h)
+
+! iir=1 : central 15um CO2 bands   
+  QIRsQREF(1,iaer,isize)=epav(2)
+  omegaIR(1,iaer,isize)=omegav(2)
+  gIR(1,iaer,isize)=gav(2)
+
+! iir=2 : CO2 band wings
+!           (same properties than for central part)
+  QIRsQREF(2,iaer,isize)=epav(2)
+  omegaIR(2,iaer,isize)=omegav(2)
+  gIR(2,iaer,isize)=gav(2)
+
+! iir=3 : 9 um band [long1ir - long1co2]
+  QIRsQREF(3,iaer,isize)=epav(1)
+  omegaIR(3,iaer,isize)=omegav(1)
+  gIR(3,iaer,isize)=gav(1)
+
+! iir=4 : Far IR    [long2co2 - long2ir]
+  QIRsQREF(4,iaer,isize)=epav(3)
+  omegaIR(4,iaer,isize)=omegav(3)
+  gIR(4,iaer,isize)=gav(3)
+
+! 2.7 Output display
+
+  WRITE(*,*) 'AEROSOL PROPERTIES: Number ',iaer
+  WRITE(*,*) 'Thermal IR (LW) ---->'
+  WRITE(*,*) 'Particle size: ',radiustab(iaer,idomain,isize)
+  WRITE(*,*) '<Qext>/Qext(longrefvis) ; omega ; g'
+  DO iir=1,nir
+    WRITE(*,*) QIRsQREF(iir,iaer,isize),omegaIR(iir,iaer,isize),&
+         gIR(iir,iaer,isize)
+  ENDDO
+  WRITE(*,*) 'CO2: <Qabs>/Qext(longrefvis) = ',&
+       QIRsQREF(1,iaer,isize)*(1-omegaIR(1,iaer,isize))
+  WRITE(*,*) ''
+
+ENDDO ! isize (particle size) -------------------------------------
+
+END SELECT domain
+!==================================================================
+! 3. Deallocate temporary variables (read in ASCII files)
+!==================================================================
+
+DEALLOCATE(wvl)        ! wvl
+DEALLOCATE(radiusdyn)  ! radiusdyn
+DEALLOCATE(ep)         ! ep 
+DEALLOCATE(omeg)       ! omeg 
+DEALLOCATE(gfactor)    ! g
+
+  END DO ! Loop on iaer
+END DO   ! Loop on idomain
+!==================================================================
+RETURN
+END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sugwd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sugwd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sugwd.F	(revision 46)
@@ -0,0 +1,109 @@
+      SUBROUTINE SUGWD(NLEV,PSIG)
+C     
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C     GRAVITY WAVE DRAG PARAMETRIZATION.
+C     
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     INPUT :
+C     
+C     PSIG        : VERTICAL COORDINATE TABLE
+C     NLEV        : NUMBER OF MODEL LEVELS
+C     
+C     OUTPUT :
+C     
+C     NONE
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     COMMON YOEGWD
+C     
+C     METHOD.
+C     -------
+C     SEE DOCUMENTATION
+C     
+C     EXTERNALS.
+C     ----------
+C     NONE
+C     
+C     REFERENCE.
+C     ----------
+C     ECMWF Research Department documentation of the IFS
+C     
+C     AUTHOR.
+C     -------
+C     MARTIN MILLER             *ECMWF*
+C     
+C     MODIFICATIONS.
+C     --------------
+C     ORIGINAL : 90-01-01
+C     ------------------------------------------------------------------
+      implicit none
+C     
+C     -----------------------------------------------------------------
+c     !-*-      include 'yoegwd.h'
+#include "yoegwd.h"
+c     !-*-
+C     ----------------------------------------------------------------
+C     
+      integer nlev
+      REAL PSIG(NLEV+1)
+
+      real zsigt,zpr,zpm1r
+      integer jk
+C     
+C     *       1.    SET THE VALUES OF THE PARAMETERS
+C     --------------------------------
+C     
+ 100  CONTINUE
+C     
+c     PRINT *,' Dans sugwd nlev=',NLEV,' SIG=',PSIG
+      GHMAX=10000.
+C     
+c     old  ZSIGT=0.94
+c     old  ZPR=80000.
+      ZSIGT=0.85
+      ZPR=100000.
+C     
+      DO 110 JK=1,NLEV-1
+         ZPM1R=0.5*ZPR*(PSIG(JK)+PSIG(JK+1))
+         IF((ZPM1R/ZPR).GE.ZSIGT)THEN
+            NKTOPG=JK
+         ENDIF
+ 110  CONTINUE
+      WRITE(*,*) 'In sugwd NKTOPG=',NKTOPG
+C     
+      GSIGCR=0.80
+C     
+      GKDRAG= 0.1  ! used to be 0.1 for mcd Version 1 and 2 (before 10/2000)
+      GRCRIT=0.25
+      GFRCRIT=1.0
+      GKWAKE=1.0
+
+C     
+      GKDRAGL=4.*GKDRAG
+      GRAHILO=1.
+      GVCRIT =0.0
+C     
+C     
+C     ----------------------------------------------------------------
+C     
+C     *       2.    SET VALUES OF SECURITY PARAMETERS
+C     ---------------------------------
+C     
+ 200  CONTINUE
+C     
+      GVSEC=0.10
+      GSSEC=1.E-12
+C     
+      GTSEC=1.E-07
+C     
+C     ----------------------------------------------------------------
+C     
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sulw.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sulw.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/sulw.F	(revision 46)
@@ -0,0 +1,81 @@
+      SUBROUTINE SULW
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "yomlw.h"
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOMLW, THE COMMON THAT CONTAINS COEFFICIENTS
+C     NEEDED TO RUN THE LONGWAVE RADIATION ROUTINES
+C     
+C     AUTHOR.
+C     -------
+C     JEAN-JACQUES MORCRETTE  *ECMWF*
+c     Simplified F. Forget 01/2000
+C     
+C     ------------------------------------------------------------------
+C     ----------------------------------------------------------------
+C     
+C     *       1.    SET VALUES.
+C     -----------
+C     
+C     
+C--   REFERENCE TEMPERATURES FOR THE PLANCK FUNCTIONS ----- TSTAND
+C     TEMPERATURE DEPENDENCE OF THE ABSORPTION ----- TREF
+      DATA TSTAND,TREF / 200.0, 200.0 /
+C     
+C--   ROOTS AND WEIGHTS FOR THE 2-POINT GAUSSIAN QUADRATURE
+c     DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
+c     DATA (WG1(IG1),IG1=1,2) /  1.0        ,  1.0         /
+
+c-----------------------------------------------------------------------
+C--   COEFFICIENTS OF THE POLYNOMIALS GIVING THE PLANCK FUNCTIONS
+C     
+      DATA xp/
+
+     s     0.63849788E+01, 0.30969419E+02, 0.44790835E+02,
+     s     0.52651048E+01,-0.18799237E+02, 0.92836181E+01,
+
+     s     0.26166790E+02, 0.12348011E+03, 0.17868306E+03,
+     s     0.33657659E+02,-0.66869343E+02, 0.21017507E+02,
+c     
+c     s  0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+c     s -0.31971883E+02, 0.59168472E+01, 0.91927407E+01,
+c     
+c     s  0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+c     s  0.35582991E+03, 0.16958020E+03,-0.41311413E+02/
+c     
+     s     0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+     s     0.35582991E+03, 0.16958020E+03,-0.41311413E+02,
+
+     s     0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+     s     -0.31971883E+02, 0.59168472E+01, 0.91927407E+01/
+
+c     
+c-----------------------------------------------------------------------
+c     temperature dependency of absorber amounts:
+c     -------------------------------------------
+
+      DATA at
+     s     / 0.694E-03, 0.272E-02, 0.275E-02, 0.178E-01/
+      DATA bt
+     s     / 0.328E-05, 0.298E-05,-0.705E-04,-0.163E-04/
+
+c-----------------------------------------------------------------------
+      DATA (ga(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.170794E-01,-0.339714E-01, 0.000000E+00/
+      DATA (gb(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.145426E-01, 0.543812E+00, 0.100000E+01/
+
+      DATA (ga(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.190634E+01, 0.384061E+01, 0.000000E+00/
+      DATA (gb(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.189485E+01, 0.600363E+01, 0.100000E+01/
+
+      DATA cst_voigt / 0.500E-02, 0.100E-01, 0.150E-01, 0.100E+00/
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfdat.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfdat.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfdat.h	(revision 46)
@@ -0,0 +1,19 @@
+      COMMON/surfdat/albedodat(ngridmx),                                &
+     &   phisfi(ngridmx),albedice(2),emisice(2),emissiv,                &
+     &   TESice_Ncoef,TESice_Scoef,                                     &
+     &   iceradius(2) , dtemisice(2),                                   &
+     &   zmea(ngridmx),zstd(ngridmx),                                   &
+     &   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+
+      COMMON/surfdatl/TESicealbedo
+
+      real albedodat ! albedo of bare ground
+      real phisfi ! geopotential at ground level
+      real albedice ! default albedo for ice (1: North H. 2: South H.)
+      real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+      real emissiv ! emissivity of bare ground
+      logical TESicealbedo ! use TES ice cap albedoes (if set to .true.)
+      real TESice_Ncoef ! coefficient for TES ice albedo in Northern hemisphere
+      real TESice_Scoef ! coefficient for TES ice albedo in Southern hemisphere
+      real iceradius , dtemisice
+      real zmea,zstd,zsig,zgam,zthe
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfini.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfini.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/surfini.F	(revision 46)
@@ -0,0 +1,67 @@
+      SUBROUTINE surfini(ngrid,piceco2,qsurf,psolaralb)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   creation des calottes pour l'etat initial
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "callkeys.h"
+#include "tracer.h"
+c
+      INTEGER ngrid,ig,icap
+      REAL  piceco2(ngrid),psolaralb(ngrid,2)
+      REAL qsurf(ngrid,nqmx) !tracer on surface (kg/m2)
+
+      EXTERNAL ISMIN,ISMAX
+      INTEGER ISMIN,ISMAX
+c
+c=======================================================================
+
+c
+c     calcul de piceco2 (kg/m2) a l'etat initial
+c     ------------------------------------------
+
+      DO 100 ig=1,ngrid
+         psolaralb(ig,1)=albedodat(ig)
+         psolaralb(ig,2)=albedodat(ig)
+100   CONTINUE
+
+      PRINT*,'minimum des donnees albedo',
+     s     albedodat(ISMIN(ngrid,albedodat,1))
+      PRINT*,'maximum des donnees albedo',
+     s     albedodat(ISMAX(ngrid,albedodat,1))
+c      calcul de psolaralb 
+c      -------------------
+      DO 115 ig=1,ngrid
+
+c	 IF (water) THEN 
+c	   if (qsurf(ig,nqmx).gt.0.005) then
+c             psolaralb(ig,1) = 0.4
+c             psolaralb(ig,2) = 0.4 
+c           endif 
+c         ENDIF
+c IF there is more than 5 pr. um of h2o ice but no C02 ice, surface albedo is set to 0.4. 
+         IF (piceco2(ig) .GT. 0.) THEN
+             IF(ig.GT.ngrid/2+1) THEN
+                icap=2
+             ELSE
+                icap=1
+             ENDIF
+             psolaralb(ig,1) = albedice(icap)
+             psolaralb(ig,2) =  albedice(icap)
+         END IF
+115   CONTINUE      
+
+      PRINT*,'minimum des donnees albedo',
+     s     psolaralb(ISMIN(ngrid,psolaralb,1),1)
+      PRINT*,'maximum des donnees albedo',
+     s     psolaralb(ISMAX(ngrid,psolaralb,1),1)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain.F	(revision 46)
@@ -0,0 +1,189 @@
+      SUBROUTINE SWMAIN ( KDLON, KFLEV,
+     $                PCST, albedo,
+     $                PRMU0, PDP, PPLEV, aerosol,PFRACT,
+     $                PHEAT, PFLUXD,PFLUXU,
+     &                QVISsQREF3d,omegaVIS3d,gVIS3d)
+
+      IMPLICIT NONE
+      
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+#include "callkeys.h"
+c     
+c     PURPOSE.
+c     --------
+c     
+c     This routine computes the shortwave (solar wavelength)
+c     radiation fluxes in two spectral intervals 
+c     and heating rate on the first "nlaylte" layers.
+C     
+c     Francois Forget (2000), adapted from 
+C     Fouquart and Bonnel's ECMWF program
+c 
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    PCST  :  Solar constant on Mars (W.m-2)
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PRMU0 :         cos of solar zenith angle (=1 when sun at zenith)
+c    PDP :           Layer thickness (Pa)
+c    PPLEV           pressure (Pa) at boundaries of each layer 
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    Pfract :        day fraction of the time interval
+c                          =1 during the full day ; =0 during the night
+c    QVISsQREF3d,omegaVIS3d,gVIS3d Aerosol optical properties
+c
+C     ==== OUTPUTS ===
+c    PHEAT :         Heating rate (K/s)
+c    PFLUXD :        SW downward flux at boundaries of each layer (W.m-2)
+c    PFLUXU :        SW upward flux at boundaries of each layer (W.m-2)
+C     
+C     ----------
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+C     ARGUMENTS
+C     ---------
+      
+      INTEGER KDLON, KFLEV
+      REAL ZPSOL(NDLO2), aerosol(NDLO2,KFLEV,naerkind),PRMU0(NDLO2)
+      real PCST
+      REAL albedo(NDLO2,2)
+      REAL PDP(NDLO2,KFLEV)
+      REAL PPLEV(NDLO2,KFLEV+1)
+      REAL PHEAT(NDLO2,KFLEV)
+      REAL PFRACT(NDLO2)
+      real PFLUXD(NDLON,NFLEV+1,2)
+      real PFLUXU(NDLON,NFLEV+1,2)
+      REAL :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL :: gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      
+C     LOCAL ARRAYS
+C     ------------
+      
+      REAL ZDSIG(NDLON,NFLEV), ZFACT(NDLON)
+     S     ,  ZFD(NDLON,NFLEV+1)
+     S     ,  ZFU(NDLON,NFLEV+1)
+     S     ,  ZRMU(NDLON), ZSEC(NDLON)
+     S     ,  ZUD(NDLON,3,NFLEV+1), ZUM(NDLON,NFLEV+1)
+      REAL ZSIGN(NDLON),  ZSIGO(NDLON)
+
+c following line has been changed, kflev--->nflev (to avoid error message 
+c when compiling on NASA Ames Sun)
+      REAL ZFDOWN(NDLO2,NFLEV+1),ZFUP(NDLO2,NFLEV+1)
+
+      integer jl, jk, jkp1, jkl
+      integer INU 
+      real  zdfnet
+
+C     ------------------------------------------------------------------
+C     Initializations :
+C     ------------------------------------------------------------------
+
+c     Incident Solar flux and corrected angle in the atmosphere 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+c        Incident Flux at the top of the atmosphere
+         ZFACT(JL)= PRMU0(JL) * PCST * PFRACT(JL)
+
+c        Cos of solar zenith angle CORRECTED for high zenith angle
+       if (PRMU0(JL).GT.0) then
+         ZRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
+       else
+         ZRMU(JL)= 1. / 35.
+       endif
+         ZSEC(JL)=1./ZRMU(JL)
+      END DO
+
+c     Calcul of ZDSIG  (thickness of layers in sigma coordinates)
+c     ~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+         ZSIGO(JL) = 1.0
+         ZPSOL(JL) = PPLEV(JL,1)
+      END DO
+      DO JK = 1 , nlaylte
+         JKP1 = JK + 1
+         JKL = nlaylte+1 - JK
+         DO  JL = 1 , KDLON
+            ZSIGN(JL) = PPLEV(JL,JKP1) / PPLEV(JL,1)
+            ZDSIG(JL,JK) = ZSIGO(JL) - ZSIGN(JL)
+            ZSIGO(JL) = ZSIGN(JL)
+         END DO
+      END DO
+
+C------------------------------------------------------------------
+C          LOOP ON SPECTRAL INTERVAL in solar spectrum
+C------------------------------------------------------------------
+c  2 spectral interval in solar spectrum :
+c  - INU=1: between wavelength "long1vis" and "long2vis" set in dimradmars.h
+c  - INU=2: between wavelength "long2vis" and "long3vis" set in dimradmars.h
+
+      DO INU = 1,2
+
+! NB: swrtype is set in callkeys.h
+        if (swrtype.eq.1) then ! Fouquart
+          CALL SWR_FOUQUART( KDLON, kflev, INU
+     &     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &     ,  ZFD,ZFU )
+        else
+          if (swrtype.eq.2) then ! Toon
+            CALL SWR_TOON( KDLON, kflev, INU
+     &       ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &       ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &       ,  ZFD,ZFU )
+          else
+            write(*,*) "swmain: invalid swrtype value !!"
+            stop
+          endif ! of if (swrtype.eq.2)
+        endif ! of if (swrtype.eq.1)
+        
+         DO JK = 1 , nlaylte+1
+            DO  JL = 1 , KDLON
+              PFLUXD(JL,JK,INU)=ZFD(JL,JK)*ZFACT(JL)
+              PFLUXU(JL,JK,INU)=ZFU(JL,JK)*ZFACT(JL)
+            END DO
+         END DO
+      END DO ! of DO INU=1,2
+
+C     ------------------------------------------------------
+C     HEATING RATES
+C     ------------------------------------------------------
+
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           wavelength integrated flux at every level:
+            ZFUP(JL,JK)= (PFLUXU(JL,JK,1)+ PFLUXU(JL,JK,2))
+            ZFDOWN(JL,JK)= (PFLUXD(JL,JK,1)+ PFLUXD(JL,JK,2))
+         END DO
+      END DO
+     
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZDFNET = ZFUP (JL,JK  ) - ZFDOWN(JL,JK  )
+     S              -ZFUP (JL,JK+1) + ZFDOWN(JL,JK+1)
+c           Heating rate
+            PHEAT(JL,JK) = gcp * ZDFNET / PDP(JL,JK)
+         END DO
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain_SP36.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain_SP36.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swmain_SP36.old	(revision 46)
@@ -0,0 +1,189 @@
+      SUBROUTINE SWMAIN ( KDLON, KFLEV,
+     $                PCST, albedo,
+     $                PRMU0, PDP, PPLEV, aerosol,PFRACT,
+     $                PHEAT, PFLUXD,PFLUXU,
+     &                QVISsQREF3d,omegaVIS3d,gVIS3d)
+
+      IMPLICIT NONE
+      
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+#include "callkeys.h"
+c     
+c     PURPOSE.
+c     --------
+c     
+c     This routine computes the shortwave (solar wavelength)
+c     radiation fluxes in two spectral intervals 
+c     and heating rate on the first "nlaylte" layers.
+C     
+c     Francois Forget (2000), adapted from 
+C     Fouquart and Bonnel's ECMWF program
+c 
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    PCST  :  Solar constant on Mars (W.m-2)
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PRMU0 :         cos of solar zenith angle (=1 when sun at zenith)
+c    PDP :           Layer thickness (Pa)
+c    PPLEV           pressure (Pa) at boundaries of each layer 
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    Pfract :        day fraction of the time interval
+c                          =1 during the full day ; =0 during the night
+c    QVISsQREF3d,omegaVIS3d,gVIS3d Aerosol optical properties
+c
+C     ==== OUTPUTS ===
+c    PHEAT :         Heating rate (K/s)
+c    PFLUXD :        SW downward flux at boundaries of each layer (W.m-2)
+c    PFLUXU :        SW upward flux at boundaries of each layer (W.m-2)
+C     
+C     ----------
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+C     ARGUMENTS
+C     ---------
+      
+      INTEGER KDLON, KFLEV
+      REAL ZPSOL(NDLO2), aerosol(NDLO2,KFLEV,naerkind),PRMU0(NDLO2)
+      real PCST
+      REAL albedo(NDLO2,2)
+      REAL PDP(NDLO2,KFLEV)
+      REAL PPLEV(NDLO2,KFLEV+1)
+      REAL PHEAT(NDLO2,KFLEV)
+      REAL PFRACT(NDLO2)
+      real PFLUXD(NDLON,NFLEV+1,2)
+      real PFLUXU(NDLON,NFLEV+1,2)
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      
+C     LOCAL ARRAYS
+C     ------------
+      
+      REAL ZDSIG(NDLON,NFLEV), ZFACT(NDLON)
+     S     ,  ZFD(NDLON,NFLEV+1)
+     S     ,  ZFU(NDLON,NFLEV+1)
+     S     ,  ZRMU(NDLON), ZSEC(NDLON)
+     S     ,  ZUD(NDLON,3,NFLEV+1), ZUM(NDLON,NFLEV+1)
+      REAL ZSIGN(NDLON),  ZSIGO(NDLON)
+
+c following line has been changed, kflev--->nflev (to avoid error message 
+c when compiling on NASA Ames Sun)
+      REAL ZFDOWN(NDLO2,NFLEV+1),ZFUP(NDLO2,NFLEV+1)
+
+      integer jl, jk, jkp1, jkl
+      integer INU 
+      real  zdfnet
+
+C     ------------------------------------------------------------------
+C     Initializations :
+C     ------------------------------------------------------------------
+
+c     Incident Solar flux and corrected angle in the atmosphere 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+c        Incident Flux at the top of the atmosphere
+         ZFACT(JL)= PRMU0(JL) * PCST * PFRACT(JL)
+
+c        Cos of solar zenith angle CORRECTED for high zenith angle
+       if (PRMU0(JL).GT.0) then
+         ZRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
+       else
+         ZRMU(JL)= 1. / 35.
+       endif
+         ZSEC(JL)=1./ZRMU(JL)
+      END DO
+
+c     Calcul of ZDSIG  (thickness of layers in sigma coordinates)
+c     ~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+         ZSIGO(JL) = 1.0
+         ZPSOL(JL) = PPLEV(JL,1)
+      END DO
+      DO JK = 1 , nlaylte
+         JKP1 = JK + 1
+         JKL = nlaylte+1 - JK
+         DO  JL = 1 , KDLON
+            ZSIGN(JL) = PPLEV(JL,JKP1) / PPLEV(JL,1)
+            ZDSIG(JL,JK) = ZSIGO(JL) - ZSIGN(JL)
+            ZSIGO(JL) = ZSIGN(JL)
+         END DO
+      END DO
+
+C------------------------------------------------------------------
+C          LOOP ON SPECTRAL INTERVAL in solar spectrum
+C------------------------------------------------------------------
+c  2 spectral interval in solar spectrum :
+c  - INU=1: between wavelength "long1vis" and "long2vis" set in dimradmars.h
+c  - INU=2: between wavelength "long2vis" and "long3vis" set in dimradmars.h
+
+      DO INU = 1,2
+
+! NB: swrtype is set in callkeys.h
+        if (swrtype.eq.1) then ! Fouquart
+          CALL SWR_FOUQUART( KDLON, kflev, INU
+     &     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &     ,  ZFD,ZFU )
+        else
+          if (swrtype.eq.2) then ! Toon
+            CALL SWR_TOON( KDLON, kflev, INU
+     &       ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &       ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &       ,  ZFD,ZFU )
+          else
+            write(*,*) "swmain: invalid swrtype value !!"
+            stop
+          endif ! of if (swrtype.eq.2)
+        endif ! of if (swrtype.eq.1)
+        
+         DO JK = 1 , nlaylte+1
+            DO  JL = 1 , KDLON
+              PFLUXD(JL,JK,INU)=ZFD(JL,JK)*ZFACT(JL)
+              PFLUXU(JL,JK,INU)=ZFU(JL,JK)*ZFACT(JL)
+            END DO
+         END DO
+      END DO ! of DO INU=1,2
+
+C     ------------------------------------------------------
+C     HEATING RATES
+C     ------------------------------------------------------
+
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           wavelength integrated flux at every level:
+            ZFUP(JL,JK)= (PFLUXU(JL,JK,1)+ PFLUXU(JL,JK,2))
+            ZFDOWN(JL,JK)= (PFLUXD(JL,JK,1)+ PFLUXD(JL,JK,2))
+         END DO
+      END DO
+     
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZDFNET = ZFUP (JL,JK  ) - ZFDOWN(JL,JK  )
+     S              -ZFUP (JL,JK+1) + ZFDOWN(JL,JK+1)
+c           Heating rate
+            PHEAT(JL,JK) = gcp * ZDFNET / PDP(JL,JK)
+         END DO
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_fouquart.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_fouquart.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_fouquart.F	(revision 46)
@@ -0,0 +1,534 @@
+      SUBROUTINE SWR_FOUQUART ( KDLON, KFLEV, KNU
+     S     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,PDSIG,PPSOL,PRMU,PSEC
+     S     ,  PFD,PFU )
+
+      IMPLICIT NONE
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+C     
+C   SWR - Continuum scattering computations
+C     
+C     PURPOSE.
+C     --------
+C     Computes the reflectivity and transmissivity in case oF
+C     Continuum scattering
+c     F. Forget (1999)
+c
+c      BASED ON MORCRETTE EARTH MODEL
+C     (See radiation's part of the ecmwf research department
+C     documentation, and Fouquart and BonneL (1980)
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    KFLEV :  number of vertical layers
+c    KNU   :   Solar band # (1 or 2)
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PDSIG      layer thickness in sigma coordinates
+c    PPSOL       Surface pressure (Pa)
+c    PRMU:  cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c    PSEC   =1./PRMU
+
+C     ==== OUTPUTS ===
+c
+c    PFD : downward flux in spectral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+c    PFU : upward flux in specatral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+C
+C     
+C     METHOD.
+C     -------
+C     
+C     Computes continuum fluxes corresponding to aerosoL
+C     Or/and rayleigh scattering (no molecular gas absorption)
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+     
+C     ARGUMENTS
+C     ---------
+      INTEGER KDLON, KFLEV, KNU
+      REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2), 
+     S     PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
+
+      REAL QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+
+      REAL PPSOL(NDLO2)
+      REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
+      REAL PRMU(NDLO2)
+
+C     LOCAL ARRAYS
+C     ------------
+ 
+      INTEGER jk,ja,jl,jae, jkl,jklp1,jkm1,jaj
+      REAL ZTRAY, ZRATIO,ZGAR, ZFF
+      real zfacoa,zcorae
+      real ZMUE, zgap,zbmu0, zww,zto,zden,zmu1,zbmu1,zden1,zre11
+
+      REAL ZC1I(NDLON,NFLEV+1), ZGG(NDLON), ZREF(NDLON)
+     S ,  ZRE1(NDLON), ZRE2(NDLON)
+     S ,  ZRMUZ(NDLON), ZRNEB(NDLON), ZR21(NDLON)
+     S ,  ZR23(NDLON),  ZSS1(NDLON), ZTO1(NDLON), ZTR(NDLON,2,NFLEV+1)
+     S ,  ZTR1(NDLON), ZTR2(NDLON), ZW(NDLON)
+
+      REAL ZRAY1(NDLO2,NFLEV+1), ZRAY2(NDLO2,NFLEV+1)
+     s   ,  ZREFZ(NDLO2,2,NFLEV+1)
+     S   ,  ZRMUE(NDLO2,NFLEV+1)
+     S   ,  ZCGAZ(NDLO2,NFLEV),ZPIZAZ(NDLO2,NFLEV),ZTAUAZ(NDLO2,NFLEV)
+
+      REAL  ZRAYL(NDLON)
+     S     ,   ZRJ(NDLON,6,NFLEV+1)
+     S     ,  ZRK(NDLON,6,NFLEV+1)
+     S     ,  ZTRA1(NDLON,NFLEV+1), ZTRA2(NDLON,NFLEV+1)
+
+c     Function
+c     --------
+      real CVMGT
+
+C    --------------------------------
+C     OPTICAL PARAMETERS FOR AEROSOLS 
+C     -------------------------------
+C     
+      DO  JK = 1 , nlaylte+1
+         DO  JA = 1 , 6
+            DO JL = 1 , KDLON
+               ZRJ(JL,JA,JK) = 0.
+               ZRK(JL,JA,JK) = 0.
+            END DO
+         END DO
+      END DO
+
+c Computing TOTAL single scattering parameters by adding
+c  properties of all the NAERKIND kind of aerosols
+
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZCGAZ(JL,JK) = 0.
+            ZPIZAZ(JL,JK) =  0.
+            ZTAUAZ(JL,JK) = 0.
+         END DO
+         DO 106 JAE=1,naerkind
+            DO 105 JL = 1 , KDLON
+c              Mean Extinction optical depth in the spectral band
+c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)
+     S              +aerosol(JL,JK,JAE)*QVISsQREF3d(JL,JK,KNU,JAE)
+c              Single scattering albedo
+c              ~~~~~~~~~~~~~~~~~~~~~~~~
+               ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)
+c              Assymetry factor
+c              ~~~~~~~~~~~~~~~~
+               ZCGAZ(JL,JK) =  ZCGAZ(JL,JK) +aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
+ 105        CONTINUE
+ 106     CONTINUE
+      END DO
+C     
+      DO JK = 1 , nlaylte
+         DO JL = 1 , KDLON
+            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
+     S            (ZPIZAZ(JL,JK).EQ.0) )
+            ZPIZAZ(JL,JK) = CVMGT( 1., ZPIZAZ(JL,JK) / ZTAUAZ(JL,JK),
+     S           (ZTAUAZ(JL,JK).EQ.0) )
+         END DO
+      END DO
+
+C     --------------------------------
+C     INCLUDING RAYLEIGH SCATERRING 
+C     -------------------------------
+      if (rayleigh) then 
+
+        call swrayleigh(kdlon,knu,ppsol,prmu,ZRAYL)
+
+c       Modifying mean aerosol parameters to account rayleigh scat by gas:
+
+        DO JK = 1 , nlaylte
+           DO JL = 1 , KDLON
+c             Rayleigh opacity in each layer :
+              ZTRAY = ZRAYL(JL) * PDSIG(JL,JK)
+c             ratio Tau(rayleigh) / Tau (total)
+              ZRATIO = ZTRAY / (ZTRAY + ZTAUAZ(JL,JK))
+              ZGAR = ZCGAZ(JL,JK)
+              ZFF = ZGAR * ZGAR
+                ZTAUAZ(JL,JK)=ZTRAY+ZTAUAZ(JL,JK)*(1.-ZPIZAZ(JL,JK)*ZFF)
+              ZCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
+              ZPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*ZPIZAZ(JL,JK)*(1.-ZFF)
+     S           / (1. -ZPIZAZ(JL,JK) * ZFF)
+           END DO
+        END DO
+      end if
+
+     
+C     ----------------------------------------------
+C     TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
+C     ----------------------------------------------
+C     
+ 200  CONTINUE
+      
+      DO JL = 1 , KDLON
+         ZR23(JL) = 0.
+         ZC1I(JL,nlaylte+1) = 0.
+      END DO
+      
+      DO JK = 1 , nlaylte
+         JKL = nlaylte+1 - JK
+         JKLP1 = JKL + 1
+         DO JL = 1 , KDLON
+            ZFACOA = 1.-ZPIZAZ(JL,JKL)*ZCGAZ(JL,JKL)*ZCGAZ(JL,JKL)
+            ZCORAE = ZFACOA * ZTAUAZ(JL,JKL) * PSEC(JL)
+            ZR21(JL) = EXP(-ZCORAE   )
+            ZSS1(JL) =  1.0-ZR21(JL)
+            ZC1I(JL,JKL) = 1.0-(1.0-ZSS1(JL))*(1.0-ZC1I(JL,JKLP1))
+         END DO
+      END DO
+
+C     -----------------------------------------------
+C     REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
+C     -----------------------------------------------
+C     
+      DO JL = 1 , KDLON
+         ZRAY1(JL,nlaylte+1) = 0.
+         ZRAY2(JL,nlaylte+1) = 0.
+         ZREFZ(JL,2,1) = albedo(JL,KNU)
+         ZREFZ(JL,1,1) = albedo(JL,KNU)
+         ZTRA1(JL,nlaylte+1) = 1.
+         ZTRA2(JL,nlaylte+1) = 1.
+      END DO
+
+      DO JK = 2 , nlaylte+1
+         JKM1 = JK-1
+         DO 342 JL = 1 , KDLON
+            ZRNEB(JL)= 1.e-5   ! used to be "cloudiness" (PCLDSW in Morcrette)
+
+            ZRE1(JL)=0.
+            ZTR1(JL)=0.
+            ZRE2(JL)=0.
+            ZTR2(JL)=0.
+      
+C           EQUIVALENT ZENITH ANGLE
+c           ~~~~~~~~~~~~~~~~~~~~~~~
+            ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL)
+     S           + ZC1I(JL,JK) * 1.66
+            ZRMUE(JL,JK) = 1./ZMUE
+
+C     ------------------------------------------------------------------
+C          REFLECT./TRANSMISSIVITY DUE TO AEROSOLS (and rayleigh ?)
+C     ------------------------------------------------------------------
+
+            ZGAP = ZCGAZ(JL,JKM1)
+            ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
+            ZWW =ZPIZAZ(JL,JKM1)
+            ZTO = ZTAUAZ(JL,JKM1)
+            ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
+     S           + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
+            ZRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
+            ZTRA1(JL,JKM1) = 1. / ZDEN
+C     
+            ZMU1 = 0.5
+            ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
+            ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
+     S         + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
+            ZRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
+            ZTRA2(JL,JKM1) = 1. / ZDEN1
+
+            ZGG(JL) =  ZCGAZ(JL,JKM1)
+            ZW(JL) =ZPIZAZ(JL,JKM1)
+            ZREF(JL) = ZREFZ(JL,1,JKM1)
+            ZRMUZ(JL) = ZRMUE(JL,JK)
+            ZTO1(JL) =  ZTAUAZ(JL,JKM1)/ZPIZAZ(JL,JKM1)
+
+ 342     CONTINUE
+
+C     
+         CALL DEDD ( KDLON
+     S        , ZGG,ZREF,ZRMUZ,ZTO1,ZW
+     S        , ZRE1,ZRE2,ZTR1,ZTR2     )
+C     
+         DO JL = 1 , KDLON
+C     
+            ZREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,1,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           + ZRNEB(JL) * ZRE2(JL)
+C     
+            ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (ZTRA1(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           * (1.-ZRNEB(JL))
+C     
+            ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1) )
+     S           + ZRNEB(JL) * ZRE1(JL)
+C     
+            ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)
+     S           + ZTRA1(JL,JKM1) * (1.-ZRNEB(JL))
+C     
+         END DO
+      END DO 
+C     
+C     
+C     ------------------------------------------------------------------
+C     
+C     *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
+C     -------------------------------------------------
+C     
+ 350  CONTINUE
+C     
+      IF (KNU.EQ.1) THEN
+         JAJ = 2
+         DO 351 JL = 1 , KDLON
+            ZRJ(JL,JAJ,nlaylte+1) = 1.
+            ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL, 1,nlaylte+1)
+ 351     CONTINUE
+C     
+         DO 353 JK = 1 , nlaylte
+            JKL = nlaylte+1 - JK
+            JKLP1 = JKL + 1
+            DO 352 JL = 1 , KDLON
+               ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
+               ZRJ(JL,JAJ,JKL) = ZRE11
+               ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,  1,JKL)
+ 352        CONTINUE
+ 353     CONTINUE
+ 354     CONTINUE
+C     
+      ELSE
+C     
+         DO 358 JAJ = 1 , 2
+            DO 355 JL = 1 , KDLON
+               ZRJ(JL,JAJ,nlaylte+1) = 1.
+               ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL,JAJ,nlaylte+1)
+ 355        CONTINUE
+C     
+            DO 357 JK = 1 , nlaylte
+               JKL = nlaylte+1 - JK
+               JKLP1 = JKL + 1
+               DO 356 JL = 1 , KDLON
+                  ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
+                  ZRJ(JL,JAJ,JKL) = ZRE11
+                  ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,JAJ,JKL)
+ 356           CONTINUE
+ 357        CONTINUE
+ 358     CONTINUE
+      END IF
+
+C     
+C     
+C     
+C     ------------------------------------------------------------------
+C     ---------------
+C     DOWNWARD FLUXES
+C     ---------------
+C    
+      JAJ = 2
+
+      do JK = 1 , nlaylte+1
+        JKL = nlaylte+1 - JK + 1
+        DO  JL = 1 , KDLON
+            PFD(JL,JKL) =   ZRJ(JL,JAJ,JKL) * sunfr(KNU)
+        end do
+      end do
+C    
+C  -------------
+C  UPWARD FLUXES
+C  -------------
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           ZRK = upward flux / incident top flux
+            PFU(JL,JK) =    ZRK(JL,JAJ,JK) * sunfr(KNU)
+         END DO
+      END DO
+
+C     
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+     S                ,      PRE1,PRE2,PTR1,PTR2         )
+      implicit none
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+C
+C**** *DEDD* - DELTA-EDDINGTON IN A CLOUDY LAYER
+C
+C     PURPOSE.
+C     --------
+C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
+C     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
+C
+C**   INTERFACE.
+C     ----------
+C          *DEDD* IS CALLED BY *SW*.
+C
+C     SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+C    S                ,      PRE1,PRE2,PTR1,PTR2         )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C PGG    : (NDLON)             ; ASSYMETRY FACTOR
+C PREF   : (NDLON)             ; REFLECTIVITY OF THE UNDERLYING LAYER
+C PRMUZ  : (NDLON)             ; COSINE OF SOLAR ZENITH ANGLE
+C PTO1   : (NDLON)             ; OPTICAL THICKNESS
+C PW     : (NDLON)             ; SINGLE SCATTERING ALBEDO
+C     ==== OUTPUTS ===
+C PRE1   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR1   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PRE2   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR2   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
+C
+C     EXTERNALS.
+C     ----------
+C
+C          NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
+C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL"
+C
+C     AUTHOR.
+C     -------
+C        JEAN-JACQUES MORCRETTE  *ECMWF*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 88-12-15
+C     ------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+      INTEGER KDLON
+C
+      REAL PGG(NDLO2),PREF(NDLO2),PRMUZ(NDLO2),PTO1(NDLO2),PW(NDLO2)
+      REAL PRE1(NDLO2),PRE2(NDLO2),PTR1(NDLO2),PTR2(NDLO2)
+
+c   local
+      integer jl
+      real*8 ZFF,ZGP,ZTOP,ZWCP,ZDT,ZX1,ZWM,ZRM2,ZRK,ZX2,ZRP,ZALPHA
+      real*8 ZBETA,ZEXMU0,ZEXKP,ZEXKM,ZXP2P,ZXM2P,ZAP2B,ZAM2B
+      real*8 ZA11,ZA12,ZA13,ZA22,ZA21,ZA23,ZDENA,ZC1A,ZC2A
+      real*8 ZRI0A,ZRI1A,ZRI0B,ZRI1B
+      real*8 ZB21,ZB22,ZB23,ZDENB,ZC1B,ZC2B
+      real*8 ZRI0C,ZRI1C,ZRI0D,ZRI1D
+C
+C     ------------------------------------------------------------------
+C
+C*         1.      DELTA-EDDINGTON CALCULATIONS
+C
+ 100  CONTINUE
+C
+      DO 131 JL   =   1 , KDLON
+C
+C*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
+C
+ 110  CONTINUE
+C
+      ZFF = PGG(JL)*PGG(JL)
+      ZGP = PGG(JL)/(1.+PGG(JL))
+      ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
+      ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
+      ZDT = 2./3.
+      ZX1 = 1.-ZWCP*ZGP
+      ZWM = 1.-ZWCP
+      ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
+      ZRK = SQRT(3.*ZWM*ZX1)
+      ZX2 = 4.*(1.-ZRK*ZRK*ZRM2)
+      ZRP = SQRT(3.*ZWM/ZX1)
+      ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2
+      ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2
+      ZEXMU0 = EXP(-ZTOP/ PRMUZ(JL) )
+      ZEXKP = EXP(ZRK*ZTOP)
+      ZEXKM = 1./ZEXKP
+      ZXP2P = 1.+ZDT*ZRP
+      ZXM2P = 1.-ZDT*ZRP
+      ZAP2B = ZALPHA+ZDT*ZBETA
+      ZAM2B = ZALPHA-ZDT*ZBETA
+C
+C*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
+C
+ 120  CONTINUE
+C
+      ZA11 = ZXP2P
+      ZA12 = ZXM2P
+      ZA13 = ZAP2B
+      ZA22 = ZXP2P*ZEXKP
+      ZA21 = ZXM2P*ZEXKM
+      ZA23 = ZAM2B*ZEXMU0
+      ZDENA = ZA11 * ZA22 - ZA21 * ZA12
+      ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
+      ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
+      ZRI0A = ZC1A+ZC2A-ZALPHA
+      ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
+      PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
+      ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
+      ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
+      PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
+C
+C*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
+C
+ 130  CONTINUE
+C
+      ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
+      ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
+      ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
+      ZDENB = ZA11 * ZB22 - ZB21 * ZA12
+      ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
+      ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
+      ZRI0C = ZC1B+ZC2B-ZALPHA
+      ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
+      PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
+      ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
+      ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
+      PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
+C
+ 131  CONTINUE
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_toon.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_toon.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swr_toon.F	(revision 46)
@@ -0,0 +1,512 @@
+      SUBROUTINE SWR_TOON ( KDLON, KFLEV, KNU
+     S     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,PDSIG,PPSOL,PRMU,PSEC
+     S     ,  PFD,PFU )
+
+      IMPLICIT NONE
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+C     
+C   SWR - Continuum scattering computations
+C     
+C     PURPOSE.
+C     --------
+C     Computes the reflectivity and transmissivity in case oF
+C     Continuum scattering
+c     F. Forget (1999)
+c    
+c     Modified by Tran The Trung, using radiative transfer code 
+c     of Toon 1981.  
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    KFLEV :  number of vertical layers
+c    KNU   :   Solar band # (1 or 2)
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PDSIG      layer thickness in sigma coordinates
+c    PPSOL       Surface pressure (Pa)
+c    PRMU:  cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c    PSEC   =1./PRMU
+
+C     ==== OUTPUTS ===
+c
+c    PFD : downward flux in spectral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+c    PFU : upward flux in specatral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+C
+C     
+C     METHOD.
+C     -------
+C     
+C     Computes continuum fluxes corresponding to aerosoL
+C     Or/and rayleigh scattering (no molecular gas absorption)
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+     
+C     ARGUMENTS
+C     ---------
+      INTEGER KDLON, KFLEV, KNU
+      REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2), 
+     S     PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
+
+      REAL QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)  
+      REAL omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)   
+      REAL gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+
+      REAL PPSOL(NDLO2)
+      REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
+      REAL PRMU(NDLO2)
+
+C     LOCAL ARRAYS
+C     ------------
+ 
+      INTEGER jk,jl,jae
+      REAL ZTRAY, ZRATIO,ZGAR, ZFF
+      REAL ZCGAZ(NDLO2,NFLEV),ZPIZAZ(NDLO2,NFLEV),ZTAUAZ(NDLO2,NFLEV)
+      REAL  ZRAYL(NDLON)
+
+c     Part added by Tran The Trung
+c     inputs to gfluxv 
+      REAL*8 DTDEL(nlaylte), WDEL(nlaylte), CDEL(nlaylte)
+c     outputs of gfluxv
+      REAL*8 FP(nlaylte+1), FM(nlaylte+1)      
+c     normalization of top downward flux
+      REAL*8 norm
+c     End part added by Tran The Trung
+
+c     Function
+c     --------
+      real CVMGT
+
+c Computing TOTAL single scattering parameters by adding
+c  properties of all the NAERKIND kind of aerosols
+
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZCGAZ(JL,JK) = 0.
+            ZPIZAZ(JL,JK) =  0.
+            ZTAUAZ(JL,JK) = 0.
+         END DO 
+         DO 106 JAE=1,naerkind
+            DO 105 JL = 1 , KDLON
+c              Mean Extinction optical depth in the spectral band
+c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)
+     S              +aerosol(JL,JK,JAE)*QVISsQREF3d(JL,JK,KNU,JAE)
+c              Single scattering albedo
+c              ~~~~~~~~~~~~~~~~~~~~~~~~ 
+               ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)
+c              Assymetry factor
+c              ~~~~~~~~~~~~~~~~
+               ZCGAZ(JL,JK) =  ZCGAZ(JL,JK) +aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
+ 105        CONTINUE
+ 106     CONTINUE
+      END DO
+C     
+      DO JK = 1 , nlaylte
+         DO JL = 1 , KDLON
+            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
+     S            (ZPIZAZ(JL,JK).EQ.0) )
+            ZPIZAZ(JL,JK) = CVMGT( 1., ZPIZAZ(JL,JK) / ZTAUAZ(JL,JK),
+     S           (ZTAUAZ(JL,JK).EQ.0) )
+         END DO
+      END DO
+
+C     --------------------------------
+C     INCLUDING RAYLEIGH SCATERRING 
+C     -------------------------------
+      if (rayleigh) then 
+
+        call swrayleigh(kdlon,knu,ppsol,prmu,ZRAYL)
+
+c       Modifying mean aerosol parameters to account rayleigh scat by gas:
+
+        DO JK = 1 , nlaylte
+           DO JL = 1 , KDLON
+c             Rayleigh opacity in each layer :
+              ZTRAY = ZRAYL(JL) * PDSIG(JL,JK)
+c             ratio Tau(rayleigh) / Tau (total)
+              ZRATIO = ZTRAY / (ZTRAY + ZTAUAZ(JL,JK))
+              ZGAR = ZCGAZ(JL,JK)
+              ZFF = ZGAR * ZGAR
+                ZTAUAZ(JL,JK)=ZTRAY+ZTAUAZ(JL,JK)*(1.-ZPIZAZ(JL,JK)*ZFF)
+              ZCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
+              ZPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*ZPIZAZ(JL,JK)*(1.-ZFF)
+     S           / (1. -ZPIZAZ(JL,JK) * ZFF)
+           END DO
+        END DO
+      end if
+
+c     Part added by Tran The Trung
+c     new radiative transfer
+
+      do JL = 1, KDLON
+
+c     assign temporary inputs
+        do JK = 1, nlaylte
+           jae = nlaylte+1-JK
+           DTDEL(JK) = real(ZTAUAZ(JL,jae),8)
+           WDEL(JK) = real(ZPIZAZ(JL,jae),8)
+           CDEL(JK) = real(ZCGAZ(JL,jae),8)
+        end do
+
+c     call gfluxv
+        call gfluxv(nlaylte, DTDEL,WDEL,CDEL,
+     S              real(PRMU(JL),8),
+     S              real(albedo(JL,KNU),8),
+     S              FP,FM)
+
+c     assign output
+        norm = FM(1)
+c     here we can have a check of norm not being 0.0
+c     however it would never happen in practice, 
+c     so we can comment out
+c        if (norm .gt. 0.0) then
+          do JK = 1, nlaylte+1
+             jae = nlaylte+2-JK
+             PFU(JL,JK) = sunfr(KNU)*real(FP(jae)/norm,4)
+             PFD(JL,JK) = sunfr(KNU)*real(FM(jae)/norm,4) 
+          end do
+c        elseif (norm .eq. 0.0) then
+c          do JK = 1, nlaylte+1
+c             PFU(JL,JK) = 0.0 
+c             PFD(JL,JK) = 0.0
+c          end do
+c        else
+c          stop "Error: top downward visible flux is negative!"
+c        end if
+ 
+      end do
+c     End part added by Tran The Trung
+
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE GFLUXV(NAYER,DTDEL,WDEL,CDEL,UBAR0,RSF
+     &                 ,FP,FM)
+      IMPLICIT NONE
+C  THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITONS
+C  FOR THE VISIBLE  FLUX AT ONE WAVELENGTH AND SOLVES FOR THE FLUXES AT
+C  THE LEVELS. THIS VERSION IS SET UP TO WORK WITH LAYER OPTICAL DEPTHS
+C  MEASURED FROM THE TOP OF EACH LAYER.  (DTAU) TOP OF EACH LAYER HAS
+C  OPTICAL DEPTH TAU(N). IN THIS SUB LEVEL N IS ABOVE LAYER N. THAT IS LAYER N
+C  HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES
+C  FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES.
+C  THIS SUBROUTINE DIFFERS FROM ITS IR CONTERPART IN THAT HERE WE SOLVE FOR
+C  THE FLUXES DIRECTLY USING THE GENERALIZED NOTATION OF MEADOR AND WEAVOR
+C  J.A.S., 37, 630-642, 1980.
+C  THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVER AND IS DOUBLE PRECISION SO MANY
+C  VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER
+
+C  THIS VERSION HAS BEEN MODIFIED BY TRAN THE TRUNG WITH:
+C   1. Simplified input & output for swr.F subroutine in LMDZ.MARS gcm model
+C   2. Use delta function to modify optical properties
+C   3. Use delta-eddington G1, G2, G3 parameters
+C   4. Optimized for speed
+
+C  INPUTS: 
+      INTEGER NAYER     
+c   NAYER = number of layer
+c            first layer is at top 
+c            last layer is at bottom
+      REAL*8 DTDEL(NAYER), WDEL(NAYER), CDEL(NAYER) 
+c   DTDEL = optical thickness of layer
+c   WDEL = single scattering of layer
+c   CDEL = assymetry parameter
+      REAL*8 UBAR0, RSF
+c   UBAR0 = absolute value of cosine of solar zenith angle
+c   RSF = surface albedo
+C  OUTPUTS:
+      REAL*8 FP(NAYER+1), FM(NAYER+1) 
+c   FP = flux up
+c   FM = flux down
+C  PRIVATES:
+      INTEGER J,NL,NLEV
+      PARAMETER (NL=201)
+C  THIS VALUE (201) MUST BE .GE. 2*NAYER
+      REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
+      REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
+      REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
+      REAL*8 G1(NL),G2(NL),G3(NL)
+      REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
+      REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
+        
+      NLEV = NAYER+1
+      
+C  TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
+c      TAU(1) = 0.0
+c      DO J=1,NAYER
+c        W0(J)=WDEL(J)
+c        COSBAR(J)=CDEL(J)
+c        DTAU(J)=DTDEL(J)
+c        TAU(J+1)=TAU(J)+DTAU(J)
+c      END DO
+C  FOR THE DELTA FUNCTION  HERE...
+      TAU(1) = 0.0
+      DO J=1,NAYER
+        COSBAR(J)=CDEL(J)/(1.+CDEL(J))
+        W0(J)=1.-WDEL(J)*CDEL(J)**2
+        DTAU(J)=DTDEL(J)*W0(J)
+        W0(J)=WDEL(J)*(1.-CDEL(J)**2)/W0(J)
+        TAU(J+1)=TAU(J)+DTAU(J)
+      END DO
+      
+c     Optimization, this is the major speed gain 
+      TAU(1) = 1.0
+      do J = 2, NAYER+1
+        TAU(J) = EXP(-TAU(J)/UBAR0)
+      end do
+      BSURF = RSF*UBAR0*TAU(NLEV)
+C  WE GO WITH THE HEMISPHERIC CONSTANT APPROACH
+C  AS DEFINED BY M&W - THIS IS THE WAY THE IR IS DONE
+      DO J=1,NAYER
+c        Optimization: ALPHA not used 
+c        ALPHA(J)=SQRT( (1.-W0(J))/(1.-W0(J)*COSBAR(J)) )
+C  SET OF CONSTANTS DETERMINED BY DOM
+c      G1(J)= (SQRT(3.)*0.5)*(2. - W0(J)*(1.+COSBAR(J)))
+c      G2(J)= (SQRT(3.)*W0(J)*0.5)*(1.-COSBAR(J))
+c      G3(J)=0.5*(1.-SQRT(3.)*COSBAR(J)*UBAR0)
+c  We use delta-Eddington instead
+        G1(J)=0.25*(7.-W0(j)*(4.+3*cosbar(j)))
+        G2(J)=-0.25*(1.-W0(j)*(4.-3*cosbar(j)))
+        G3(J)=0.5*(1.-SQRT(3.)*COSBAR(J)*UBAR0)
+        LAMDA(J)=SQRT(G1(J)**2 - G2(J)**2)
+        GAMA(J)=(G1(J)-LAMDA(J))/G2(J)
+      END DO 
+
+      DO J=1,NAYER
+        G4=1.-G3(J)
+        DENOM=LAMDA(J)**2 - 1./UBAR0**2
+C  NOTE THAT THE ALGORITHM DONOT ACCEPT UBAR0 .eq. 0
+C  THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C  THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN
+C  THE SCATTERING GOES TO ZERO
+C  PREVENT THIS WITH AN IF STATEMENT
+        IF ( DENOM .EQ. 0.) THEN
+          DENOM=1.E-6
+        END IF
+        DENOM = W0(J)/DENOM
+        AM=DENOM*(G4   *(G1(J)+1./UBAR0) +G2(J)*G3(J) )
+        AP=DENOM*(G3(J)*(G1(J)-1./UBAR0) +G2(J)*G4    )
+C  CPM1 AND CMM1 ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C  AT THE TOP OF THE LAYER, THAT IS LOWER OPTICAL DEPTH TAU(J)
+        CPM1(J)=AP*TAU(J)
+        CMM1(J)=AM*TAU(J)
+C  CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C  BOTTOM OF THE LAYER. THAT IS AT HIGHER OPTICAL DEPTH TAU(J+1)
+        CP(J)=AP*TAU(J+1)
+        CM(J)=AM*TAU(J+1)
+      END DO
+
+C  NOW CALCULATE THE EXPONENTIAL TERMS NEEDED
+C  FOR THE TRIDIAGONAL ROTATED LAYERED METHOD
+C  WARNING IF DTAU(J) IS GREATER THAN ABOUT 35
+C  WE CLIPP IT TO AVOID OVERFLOW.
+C  EXP (TAU) - EXP(-TAU) WILL BE NONSENSE THIS IS
+C  CORRECTED IN THE DSOLVER ROUTINE. ??FLAG?
+      DO J=1,NAYER
+c        EXPTRM(J) = MIN(35.,LAMDA(J)*DTAU(J))
+        EP=EXP(MIN(35.0_8,LAMDA(J)*DTAU(J)))
+        EM=1.0/EP
+        AM = GAMA(J)*EM
+        E1(J)=EP+AM
+        E2(J)=EP-AM
+        AP = GAMA(J)*EP
+        E3(J)=AP+EM
+        E4(J)=AP-EM
+      END DO
+
+      CALL DSOLVER(NAYER,GAMA,CP,CM,CPM1,CMM1
+     &            ,E1,E2,E3,E4,0.0_8,BSURF,RSF,XK1,XK2)
+
+C  EVALUATE THE NAYER FLUXES THROUGH THE NAYER LAYERS
+C  USE THE TOP (TAU=0) OPTICAL DEPTH EXPRESSIONS TO EVALUATE FP AND FM
+C  AT THE THE TOP OF EACH LAYER,J = LEVEL J
+      DO J=1,NAYER
+        FP(J)= XK1(J) + GAMA(J)*XK2(J) + CPM1(J)
+        FM(J)= GAMA(J)*XK1(J) + XK2(J) + CMM1(J)
+      END DO
+
+C  USE EXPRESSION FOR BOTTOM FLUX TO GET THE FP AND FM AT NLEV
+c     Optimization: no need this step since result of last
+c     loop at about EP above give this
+c      EP=EXP(EXPTRM(NAYER))
+c      EM=1.0/EP
+      FP(NLEV)=XK1(NAYER)*EP + XK2(NAYER)*AM + CP(NAYER)
+      FM(NLEV)=XK1(NAYER)*AP + XK2(NAYER)*EM + CM(NAYER)
+
+C  ADD THE DIRECT FLUX TERM TO THE DOWNWELLING RADIATION, LIOU 182
+      DO J=1,NLEV
+        FM(J)=FM(J)+UBAR0*TAU(J)
+      END DO
+
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,
+     *                   BSURF,RSF,XK1,XK2)
+
+C DOUBLE PRECISION VERSION OF SOLVER
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
+     *          XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
+      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
+C*********************************************************
+C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
+C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
+C* NO ASSUMPTION OF THE DEPENDENCE ON OPTICAL DEPTH OF   *
+C* C-PLUS OR C-MINUS HAS BEEN MADE.                      *
+C* NL     = NUMBER OF LAYERS IN THE MODEL                *
+C* CP     = C-PLUS EVALUATED AT TAO=0 (TOP)              *
+C* CM     = C-MINUS EVALUATED AT TAO=0 (TOP)             *
+C* CPM1   = C-PLUS  EVALUATED AT TAOSTAR (BOTTOM)        *
+C* CMM1   = C-MINUS EVALUATED AT TAOSTAR (BOTTOM)        *
+C* EP     = EXP(LAMDA*DTAU)                              *
+C* EM     = 1/EP                                         *
+C* E1     = EP + GAMA *EM                                *
+C* E2     = EP - GAMA *EM                                *
+C* E3     = GAMA*EP + EM                                 *
+C* E4     = GAMA*EP - EM                                 *
+C* BTOP   = THE DIFFUSE RADIATION INTO THE MODEL AT TOP  *
+C* BSURF  = THE DIFFUSE RADIATION INTO THE MODEL AT      *
+C*          THE BOTTOM: INCLUDES EMMISION AND REFLECTION *
+C*          OF THE UNATTENUATED PORTION OF THE DIRECT    *
+C*          BEAM. BSTAR+RSF*FO*EXP(-TAOSTAR/U0)          *
+C* RSF    = REFLECTIVITY OF THE SURFACE                  *
+C* XK1    = COEFFICIENT OF THE POSITIVE EXP TERM         *
+C* XK2    = COEFFICIENT OF THE NEGATIVE EXP TERM         *
+C*********************************************************
+C THIS ROUTINE CALLS ROUTINE DTRIDGL TO SOLVE TRIDIAGONAL
+C SYSTEMS
+C======================================================================C
+
+      L=2*NL
+ 
+C     ************MIXED COEFFICENTS**********
+C     THIS VERSION AVOIDS SINGULARITIES ASSOC.
+C     WITH W0=0 BY SOLVING FOR XK1+XK2, AND XK1-XK2.
+
+      AF(1) = 0.0
+      BF(1) = GAMA(1)+1.
+      CF(1) = GAMA(1)-1.
+      DF(1) = BTOP-CMM1(1)
+      N     = 0
+      LM2   = L-2
+
+C     EVEN TERMS
+ 
+      DO I=2,LM2,2
+        N     = N+1
+        AF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)       
+        BF(I) = (E2(N)+E4(N))*(GAMA(N+1)-1.)
+        CF(I) = 2.0*(1.-GAMA(N+1)**2)
+        DF(I) = (GAMA(N+1)-1.) * (CPM1(N+1) - CP(N)) +
+     *            (1.-GAMA(N+1))* (CM(N)-CMM1(N+1))
+      END DO
+ 
+      N   = 0
+      LM1 = L-1
+      DO I=3,LM1,2
+        N     = N+1
+        AF(I) = 2.0*(1.-GAMA(N)**2)
+        BF(I) = (E1(N)-E3(N))*(1.+GAMA(N+1))
+        CF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)
+        DF(I) = E3(N)*(CPM1(N+1) - CP(N)) + E1(N)*(CM(N) - CMM1(N+1))
+      END DO
+ 
+      AF(L) = E1(NL)-RSF*E3(NL)
+      BF(L) = E2(NL)-RSF*E4(NL)
+      CF(L) = 0.0
+      DF(L) = BSURF-CP(NL)+RSF*CM(NL)
+ 
+      CALL DTRIDGL(L,AF,BF,CF,DF,XK)
+ 
+C     ***UNMIX THE COEFFICIENTS****
+
+      DO 28 N=1,NL
+        XK1(N) = XK(2*N-1)+XK(2*N)
+        XK2(N) = XK(2*N-1)-XK(2*N)
+
+C       NOW TEST TO SEE IF XK2 IS REALLY ZERO TO THE LIMIT OF THE
+C       MACHINE ACCURACY  = 1 .E -30
+C       XK2 IS THE COEFFICIENT OF THE GROWING EXPONENTIAL AND MUST
+C       BE TREATED CAREFULLY
+
+        IF(XK2(N) .EQ. 0.0) GO TO 28
+        IF (ABS (XK2(N)/XK(2*N-1)) .LT. 1.E-30) XK2(N)=0.0
+
+   28 CONTINUE
+ 
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+
+C     DOUBLE PRECISION VERSION OF TRIDGL
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+      DIMENSION AS(NMAX),DS(NMAX)
+
+C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*    A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C*    WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+
+C======================================================================C
+
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+
+      DO I=2,L
+        X         = 1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+        AS(L+1-I) = AF(L+1-I)*X
+        DS(L+1-I) = (DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+      END DO
+ 
+      XK(1)=DS(1)
+      DO I=2,L
+        XK(I) = DS(I)-AS(I)*XK(I-1)
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swrayleigh.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swrayleigh.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/swrayleigh.F	(revision 46)
@@ -0,0 +1,86 @@
+      SUBROUTINE swrayleigh(kdlon,knu,ppsol,prmu,prayl)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing total rayleigh scat atmospheric optical depth  
+c
+c   author: F.Forget 
+c   ------
+c
+c   input:
+c   ----- 
+c   kdlon             Number of gridpoint of horizontal grid
+c    knu   :   Solar band # (1 or 2)
+c   ppsol             surface pressure (Pa) 
+c   prmu         cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c
+c   output:
+c   -------
+c   prayl       column optical depth in each model column
+c
+c=======================================================================
+#include "comcstfi.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER kdlon, knu
+
+      real ppsol(kdlon),prmu(kdlon),prayl(kdlon)
+c
+c    Local variables :
+c    -----------------
+      integer JL, K
+c
+c   local saved variables
+c   ---------------------
+c     rayleigh scattering coefficients (from Morcrete et al.EARTH model !)
+      real cray(2,6)
+
+      DATA (CRAY(1,K),K=1,6) /
+     S     .428937E-01, .890743E+00,-.288555E+01,
+     S     .522744E+01,-.469173E+01, .161645E+01/
+
+      DATA (CRAY(2,K),K=1,6) /
+     S     .697200E-02, .173297E-01,-.850903E-01,
+     S     .248261E+00,-.302031E+00, .129662E+00/
+      save cray
+c----------------------------------------------------------------------
+
+      DO JL = 1 , KDLON
+
+c        Total Rayleigh Optical thickness on Earth at 101325 Pa level
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c        WARNING : the CRAY coefficients are only valid for
+c        Spectral interval used in Earth model !!!
+c        (i.e. 0.25-0.68 micron and 0.68-4.00 micron
+c         ---> should be modified for Mars model !!!
+
+         PRAYL(JL) = CRAY(KNU,1) + PRMU(JL) * (CRAY(KNU,2) + PRMU(JL)
+     S        * (CRAY(KNU,3) + PRMU(JL) * (CRAY(KNU,4) + PRMU(JL)
+     S        * (CRAY(KNU,5) + PRMU(JL) *   CRAY(KNU,6)       ))))
+
+c        Total local Rayleigh Optical thickness on Mars
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c           - PRAYL above is the total Rayleigh Optical thickness
+c             at  101325Pa for Earth atmosphere
+c           -> Total Rayleigh Optical thickness on Mars
+c              = PRAYL*(Psurf/101325)*9.81/g *2.5
+c              (Extinction coeff of CO2 = 2.5 * N2)
+
+c     (Comment the following line to get back bugged version before 01/2000)
+c        PRAYL(JL) = PRAYL(JL) * PPSOL(JL) * 2.42e-4/g
+
+      END DO
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tabfi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tabfi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tabfi.F	(revision 46)
@@ -0,0 +1,532 @@
+c=======================================================================
+      SUBROUTINE tabfi(nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .                 p_omeg,p_g,p_mugaz,p_daysec,time)
+c=======================================================================
+c
+c   C. Hourdin 15/11/96
+c
+c   Object:        Lecture du tab_cntrl physique dans un fichier 
+c   ------            et initialisation des constantes physiques
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c      - nid:    unitne logique du fichier ou on va lire le tab_cntrl    
+c                      (ouvert dans le programme appellant) 
+c
+c                 si nid=0:
+c                       pas de lecture du tab_cntrl mais
+c                       Valeurs par default des constantes physiques
+c        
+c      - tab0:    Offset de tab_cntrl a partir duquel sont ranges 
+c                  les parametres physiques (50 pour start_archive)
+c
+c      - Lmodif:  si on souhaite modifier les constantes  Lmodif = 1 = TRUE
+c
+c
+c     Outputs:
+c     --------
+c
+c      - day_ini: tab_cntrl(tab0+3) (Dans les cas ou l'on souhaite
+c                              comparer avec le day_ini dynamique)
+c
+c      - lmax:    tab_cntrl(tab0+2) (pour test avec nlayermx)
+c
+c      - p_rad
+c      - p_omeg   !
+c      - p_g      ! Constantes physiques ayant des 
+c      - p_mugaz  ! homonymes dynamiques
+c      - p_daysec !
+c
+c=======================================================================
+ 
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "planete.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "netcdf.inc"
+#include "dimradmars.h"
+#include "yomaer.h"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c Arguments
+c ---------
+      INTEGER nid,nvarid,tab0
+      INTEGER*4 day_ini
+      INTEGER Lmodif
+      INTEGER lmax
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec,time
+
+c Variables
+c ---------
+      INTEGER length
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! array in which are stored the run's parameters
+      INTEGER  ierr
+      INTEGER size
+      CHARACTER modif*20
+
+c Fonctions DRS et autres
+c -----------------------
+      INTEGER setname, cluvdb, getdat
+
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c  Initialization of various physical constants to defaut values (nid = 0 case)
+c-----------------------------------------------------------------------
+      IF (nid.eq.0) then
+ 
+c Reference pressure
+c-------------------------------------
+c     pressrf = 670.            ! Pression de reference (Pa) ~650
+
+c Infos about Mars for the dynamics and physics
+c----------------------------------------------------------
+      rad=3397200.          ! radius of Mars (m)  ~3397200 m
+      daysec=88775.         ! length of a sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)       ! rotation rate  (rad.s-1)
+      g=3.72                ! gravity (m.s-2) ~3.72
+      mugaz=43.49           ! Molar mass of the atmosphere (g.mol-1) ~43.49
+      rcp=.256793         ! = r/cp  ~0.256793
+
+c Informations about Mars, only for physics
+c-----------------------------------------------------
+      year_day = 669.       !Modif FH: length of year (sols) ~668.6
+      periheli = 206.66         ! min. Sun-Mars distance (Mkm) ~206.66
+      aphelie = 249.22          ! max. Sun-Mars distance (Mkm) ~249.22
+      peri_day =  485.    ! date of perihelion (sols since N. spring)
+      obliquit = 25.19         ! Obliquity of the planet (deg) ~25.19
+
+c Boundary layer and turbulence
+c----------------------------
+      z0 =  1.e-2               ! surface roughness (m) ~0.01
+      emin_turb = 1.e-6         ! minimal energy ~1.e-8
+      lmixmin = 30              ! mixing length ~100
+
+c Optical properties of polar caps and ground emissivity
+c-----------------------------------------------------
+      emissiv=.95               ! Emissivity of martian soil ~.95
+      emisice(1)=0.95           ! Emissivity of northern cap
+      emisice(2)=0.95           ! Emissivity of southern cap
+      albedice(1)=0.65          ! Albedo of northern cap
+      albedice(2)=0.65          ! Albedo of southern cap
+      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) = 0.4   ! time scale for snow metamorphism (north)
+      dtemisice(2) = 0.4   ! time scale for snow metamorphism (south)
+
+c dust aerosol properties
+c---------------------------------
+      tauvis= 0.2          ! mean visible optical depth
+
+c  Ancien code radiatif (non utilise avec le code d'apres 03/96)
+c---------------------------------------------------------------
+c     tauir= 0.  ! .2  ratio (mean IR opt.depth)/Visible
+c     scatalb=0. ! .86 scaterring albedo visible (~.86)
+c     asfact=0.  ! .79 assymetrie factor visible   (~.79)
+c     day0 = 0   ! = 0 en general !!!
+
+c soil properties
+      volcapa = 1.e6 ! soil volumetric heat capacity (in comsoil.h)
+      ELSE
+c-----------------------------------------------------------------------
+c  Initialization of physical constants by reading array tab_cntrl(:)
+c		which contains these parameters	(nid != 0 case)
+c-----------------------------------------------------------------------
+c Read 'controle' array
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Could not find <controle> data"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Failed reading <controle> array"
+         CALL abort
+      ENDIF
+
+       print*,'tabfi: tab_cntrl',tab_cntrl
+c
+c  Initialization of some physical constants
+c informations on physics grid
+      if(ngridmx.ne.tab_cntrl(tab0+1)) then
+         print*,'tabfi: WARNING !!! tab_cntrl(tab0+1).ne.ngridmx'
+         print*,tab_cntrl(tab0+1),ngridmx
+      endif
+      lmax = nint(tab_cntrl(tab0+2))
+      day_ini = tab_cntrl(tab0+3)
+      time = tab_cntrl(tab0+4)
+      write (*,*) 'IN tabfi day_ini=',day_ini
+c Informations about planet Mars for dynamics and physics
+      rad = tab_cntrl(tab0+5)
+      omeg = tab_cntrl(tab0+6)
+      g = tab_cntrl(tab0+7)
+      mugaz = tab_cntrl(tab0+8)
+      rcp = tab_cntrl(tab0+9)
+      daysec = tab_cntrl(tab0+10)
+      dtphys = tab_cntrl(tab0+11)
+c Informations about planet Mars for the physics only
+      year_day = tab_cntrl(tab0+14)
+      periheli = tab_cntrl(tab0+15)
+      aphelie = tab_cntrl(tab0+16)
+      peri_day = tab_cntrl(tab0+17)
+      obliquit = tab_cntrl(tab0+18)
+c boundary layer and turbeulence
+      z0 = tab_cntrl(tab0+19)
+      lmixmin = tab_cntrl(tab0+20)
+      emin_turb = tab_cntrl(tab0+21)
+c optical properties of polar caps and ground emissivity
+      albedice(1)= tab_cntrl(tab0+22)
+      albedice(2)= tab_cntrl(tab0+23)
+      emisice(1) = tab_cntrl(tab0+24)
+      emisice(2) = tab_cntrl(tab0+25)
+      emissiv    = tab_cntrl(tab0+26)
+      tauvis     = tab_cntrl(tab0+27)  ! dust opt. depth vis.
+      iceradius(1)= tab_cntrl(tab0+31) ! mean scat radius of CO2 snow (north)
+      iceradius(2)= tab_cntrl(tab0+32) ! mean scat radius of CO2 snow (south)
+      dtemisice(1)= tab_cntrl(tab0+33) !time scale for snow metamorphism (north)
+      dtemisice(2)= tab_cntrl(tab0+34) !time scale for snow metamorphism (south)
+c soil properties
+      volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity
+c-----------------------------------------------------------------------
+c	Save some constants for later use (as routine arguments)
+c-----------------------------------------------------------------------
+      p_omeg = omeg
+      p_g = g
+      p_mugaz = mugaz
+      p_daysec = daysec
+      p_rad=rad
+
+      ENDIF    ! end of (nid = 0) 
+
+c-----------------------------------------------------------------------
+c	Write physical constants to output before modifying them
+c-----------------------------------------------------------------------
+ 
+   6  FORMAT(a20,e15.6,e15.6)
+   5  FORMAT(a20,f12.2,f12.2)
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)
+      write(*,*) 'Lmodif in tabfi!!!!!!!',Lmodif
+
+c-----------------------------------------------------------------------
+c	 Modifications...
+c-----------------------------------------------------------------------
+
+      IF(Lmodif.eq.1) then
+
+      write(*,*)
+      write(*,*) 'Change values in tab_cntrl ? :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*) '(Current values given above)'
+      write(*,*)
+      write(*,*) '(3)          day_ini : Initial day (=0 at Ls=0)'
+      write(*,*) '(19)              z0 :  surface roughness (m)'
+      write(*,*) '(21)       emin_turb :  minimal energy (PBL)'
+      write(*,*) '(20)         lmixmin : mixing length (PBL)'
+      write(*,*) '(26)         emissiv : ground emissivity'
+      write(*,*) '(24 et 25)   emisice : CO2 ice max emissivity '
+      write(*,*) '(22 et 23)  albedice : CO2 ice cap albedos'
+      write(*,*) '(31 et 32) iceradius : mean scat radius of CO2 snow'
+      write(*,*) '(33 et 34) dtemisice : time scale for snow',
+     &           ' metamorphism'
+      write(*,*) '(27)        tauvis : mean dust vis. reference ',
+     &           'opacity'
+      write(*,*) '(35)         volcapa : soil volumetric heat capacity'
+      write(*,*) '(18)        obliquit : planet obliquity (deg)'
+      write(*,*) '(17)      peri_day : perihelion date (sol since Ls=0)'
+      write(*,*) '(15)      periheli : min. sun-mars dist (Mkm)'
+      write(*,*) '(16)      aphelie  : max. sun-mars dist (Mkm)'
+      write(*,*)
+ 
+ 
+      do while(modif(1:1).ne.'hello')
+        write(*,*)
+        write(*,*)
+        write(*,*) 'Changes to perform ?'
+        write(*,*) '   (enter keyword or return )'
+        write(*,*)
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') goto 999
+ 
+        write(*,*)
+        write(*,*) modif(1:lnblnk(modif)) , ' : '
+
+        if (modif(1:lnblnk(modif)) .eq. 'day_ini') then
+          write(*,*) 'current value:',day_ini
+          write(*,*) 'enter new value:'
+ 101      read(*,*,iostat=ierr) day_ini
+          if(ierr.ne.0) goto 101
+          write(*,*) ' '
+          write(*,*) 'day_ini (new value):',day_ini
+
+        else if (modif(1:lnblnk(modif)) .eq. 'z0') then
+          write(*,*) 'current value:',z0
+          write(*,*) 'enter new value:'
+ 102      read(*,*,iostat=ierr) z0
+          if(ierr.ne.0) goto 102
+          write(*,*) ' '
+          write(*,*) ' z0 (new value):',z0
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emin_turb') then
+          write(*,*) 'current value:',emin_turb
+          write(*,*) 'enter new value:'
+ 103      read(*,*,iostat=ierr) emin_turb
+          if(ierr.ne.0) goto 103
+          write(*,*) ' '
+          write(*,*) ' emin_turb (new value):',emin_turb
+
+        else if (modif(1:lnblnk(modif)) .eq. 'lmixmin') then
+          write(*,*) 'current value:',lmixmin
+          write(*,*) 'enter new value:'
+ 104      read(*,*,iostat=ierr) lmixmin
+          if(ierr.ne.0) goto 104
+          write(*,*) ' '
+          write(*,*) ' lmixmin (new value):',lmixmin
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emissiv') then
+          write(*,*) 'current value:',emissiv
+          write(*,*) 'enter new value:'
+ 105      read(*,*,iostat=ierr) emissiv
+          if(ierr.ne.0) goto 105
+          write(*,*) ' '
+          write(*,*) ' emissiv (new value):',emissiv
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emisice') then
+          write(*,*) 'current value emisice(1) North:',emisice(1)
+          write(*,*) 'enter new value:'
+ 106      read(*,*,iostat=ierr) emisice(1)
+          if(ierr.ne.0) goto 106
+          write(*,*) 
+          write(*,*) ' emisice(1) (new value):',emisice(1)
+          write(*,*)
+
+          write(*,*) 'current value emisice(2) South:',emisice(2)
+          write(*,*) 'enter new value:'
+ 107      read(*,*,iostat=ierr) emisice(2)
+          if(ierr.ne.0) goto 107
+          write(*,*) 
+          write(*,*) ' emisice(2) (new value):',emisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'albedice') then
+          write(*,*) 'current value albedice(1) North:',albedice(1)
+          write(*,*) 'enter new value:'
+ 108      read(*,*,iostat=ierr) albedice(1)
+          if(ierr.ne.0) goto 108
+          write(*,*) 
+          write(*,*) ' albedice(1) (new value):',albedice(1)
+          write(*,*)
+
+          write(*,*) 'current value albedice(2) South:',albedice(2)
+          write(*,*) 'enter new value:'
+ 109      read(*,*,iostat=ierr) albedice(2)
+          if(ierr.ne.0) goto 109
+          write(*,*) 
+          write(*,*) ' albedice(2) (new value):',albedice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'iceradius') then
+          write(*,*) 'current value iceradius(1) North:',iceradius(1)
+          write(*,*) 'enter new value:'
+ 110      read(*,*,iostat=ierr) iceradius(1)
+          if(ierr.ne.0) goto 110
+          write(*,*) 
+          write(*,*) ' iceradius(1) (new value):',iceradius(1)
+          write(*,*)
+
+          write(*,*) 'current value iceradius(2) South:',iceradius(2)
+          write(*,*) 'enter new value:'
+ 111      read(*,*,iostat=ierr) iceradius(2)
+          if(ierr.ne.0) goto 111
+          write(*,*) 
+          write(*,*) ' iceradius(2) (new value):',iceradius(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'dtemisice') then
+          write(*,*) 'current value dtemisice(1) North:',dtemisice(1)
+          write(*,*) 'enter new value:'
+ 112      read(*,*,iostat=ierr) dtemisice(1)
+          if(ierr.ne.0) goto 112
+          write(*,*) 
+          write(*,*) ' dtemisice(1) (new value):',dtemisice(1)
+          write(*,*)
+
+          write(*,*) 'current value dtemisice(2) South:',dtemisice(2)
+          write(*,*) 'enter new value:'
+ 113      read(*,*,iostat=ierr) dtemisice(2)
+          if(ierr.ne.0) goto 113
+          write(*,*) 
+          write(*,*) ' dtemisice(2) (new value):',dtemisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'tauvis') then
+          write(*,*) 'current value:',tauvis
+          write(*,*) 'enter new value:'
+ 114      read(*,*,iostat=ierr) tauvis
+          if(ierr.ne.0) goto 114
+          write(*,*) 
+          write(*,*) ' tauvis (new value):',tauvis
+
+        else if (modif(1:lnblnk(modif)) .eq. 'obliquit') then
+          write(*,*) 'current value:',obliquit
+          write(*,*) 'obliquit should be 25.19 on current Mars'
+          write(*,*) 'enter new value:'
+ 115      read(*,*,iostat=ierr) obliquit
+          if(ierr.ne.0) goto 115
+          write(*,*) 
+          write(*,*) ' obliquit (new value):',obliquit
+
+        else if (modif(1:lnblnk(modif)) .eq. 'peri_day') then
+          write(*,*) 'current value:',peri_day
+          write(*,*) 'peri_day should be 485 on current Mars'
+          write(*,*) 'enter new value:'
+ 116      read(*,*,iostat=ierr) peri_day
+          if(ierr.ne.0) goto 116
+          write(*,*) 
+          write(*,*) ' peri_day (new value):',peri_day
+
+        else if (modif(1:lnblnk(modif)) .eq. 'periheli') then
+          write(*,*) 'current value:',periheli
+          write(*,*) 'perihelion should be 206.66 on current Mars'
+          write(*,*) 'enter new value:'
+ 117      read(*,*,iostat=ierr) periheli
+          if(ierr.ne.0) goto 117
+          write(*,*) 
+          write(*,*) ' periheli (new value):',periheli
+ 
+        else if (modif(1:lnblnk(modif)) .eq. 'aphelie') then
+          write(*,*) 'current value:',aphelie
+          write(*,*) 'aphelion should be 249.22 on current Mars'
+          write(*,*) 'enter new value:'
+ 118      read(*,*,iostat=ierr) aphelie
+          if(ierr.ne.0) goto 118
+          write(*,*) 
+          write(*,*) ' aphelie (new value):',aphelie
+ 
+        else if (modif(1:lnblnk(modif)) .eq. 'volcapa') then
+          write(*,*) 'current value:',volcapa
+          write(*,*) 'enter new value:'
+ 119      read(*,*,iostat=ierr) volcapa
+          if(ierr.ne.0) goto 119
+          write(*,*) 
+          write(*,*) ' volcapa (new value):',volcapa
+ 
+        endif
+      enddo ! of do while(modif(1:1).ne.'hello')
+
+ 999  continue
+
+c-----------------------------------------------------------------------
+c	Write values of physical constants after modifications
+c-----------------------------------------------------------------------
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+ 
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+ 
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+ 
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+ 
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)  
+      write(*,*) 
+
+      ENDIF 			!	of if (Lmodif == 1)
+
+c-----------------------------------------------------------------------
+c	Case when using a start file from before March 1996 (without iceradius...
+c-----------------------------------------------------------------------
+      if (iceradius(1).eq.0) then 
+         iceradius(1) = 100.e-6
+         iceradius(2) = 100.e-6
+         dtemisice(1) = 0.4
+         dtemisice(2) = 0.4
+         write (*,*) ' tabfi: WARNING : old initialisation file'
+         write (*,*) 'iceradius set to',iceradius(1),iceradius(2)  
+         write (*,*) 'dtemisice set to',dtemisice(1),dtemisice(2)  
+       end if
+
+c-----------------------------------------------------------------------
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/testphys1d.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/testphys1d.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/testphys1d.F	(revision 46)
@@ -0,0 +1,614 @@
+
+      PROGRAM 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 "aerdust.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:
+        q(:,:)=0 ! default, set everything to zero
+        qsurf(:)=0
+        ! "smarter" initialization of some tracers
+        do iq=1,nqmx
+          txt=""
+          write(txt,"(a)") tnom(iq)
+          ! CO2
+          if (txt.eq."co2") then
+            q(:,iq)=0.95   ! kg /kg of atmosphere
+            qsurf(iq)=0. ! kg/m2 (not used for CO2)
+          endif
+          ! DUST
+          if (txt(1:4).eq."dust") then
+            q(:,iq)=0.4    ! kg/kg of atmosphere
+            qsurf(iq)=100 ! kg/m2
+          endif
+        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 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 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: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tracer.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tracer.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/tracer.h	(revision 46)
@@ -0,0 +1,60 @@
+!-----------------------------------------------------------------------
+! INCLUDE 'tracer.h'
+
+      character*20  noms(nqmx)  ! name of the tracer
+      real mmol(nqmx)           ! mole mass of tracer (g/mol-1) 
+      real radius(nqmx)   ! dust and ice particle radius (m)
+      real rho_q(nqmx)    ! tracer densities (kg.m-3)
+      real qext(nqmx)     ! Single Scat. Extinction coeff at 0.67 um
+      real alpha_lift(nqmx) ! saltation vertical flux/horiz flux ratio (m-1)
+      real alpha_devil(nqmx) ! lifting coeeficient by dust devil
+
+      real varian      ! Characteristic variance of log-normal distribution
+      real r3n_q     ! used to compute r0 from number and mass mixing ratio
+      real qextrhor(nqmx) ! Intermediate for computing opt. depth from q
+      real rho_dust     ! Mars dust density (kg.m-3)
+      real rho_ice     ! Water ice density (kg.m-3)
+      real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+
+      real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
+      
+! tracer indexes: these are initialized in initracer and should be 0 if the
+!                 corresponding tracer does not exist
+      ! dust
+      integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+      ! dust, special doubleq case
+      integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+      integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+      ! water
+      integer :: igcm_h2o_vap ! water vapour
+      integer :: igcm_h2o_ice ! water ice
+      ! chemistry:
+      integer :: igcm_co2
+      integer :: igcm_co
+      integer :: igcm_o
+      integer :: igcm_o1d
+      integer :: igcm_o2
+      integer :: igcm_o3
+      integer :: igcm_h
+      integer :: igcm_h2
+      integer :: igcm_oh
+      integer :: igcm_ho2
+      integer :: igcm_h2o2
+      integer :: igcm_n2
+      integer :: igcm_ar
+      
+      ! other tracers
+      integer :: igcm_ar_n2 ! for simulations using co2 +neutral gas
+
+
+! NB: to keep commons aligned: 
+!     split them in groups (reals, integers and characters)
+      COMMON/tracer/radius,rho_q,qext,alpha_lift,alpha_devil,mmol,      &
+     & varian,r3n_q,qextrhor,rho_dust,rho_ice,ref_r0,dryness
+      COMMON/tracer2/
+     & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &
+     & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+     & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+     & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+      COMMON/tracer3/noms
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/updatereffrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/updatereffrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/updatereffrad.F	(revision 46)
@@ -0,0 +1,121 @@
+      SUBROUTINE updatereffrad(ngrid,nlayer,
+     &                pplev,pplay,
+     &                rice,nuice,
+     &                reffrad,nueffrad)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to update the aerosol size distribution used by
+c     the radiative transfer scheme. This size distribution is assumed
+c     to be a log-normal distribution, with effective radius "reffrad" and
+c     variance "nueffrad".
+c   At firstcall, "rice" and "nuice" are not known, because
+c     the H2O ice microphysical scheme is called after the radiative
+c     transfer in physiq.F. That's why we call watercloud at firstcall
+c     in physiq.F before calling updatereffrad. Of course, resulting
+c     tendencies are not used to compute the water cycle.
+c   See callradite.F for more information.
+c
+c   author:   
+c   ------
+c   J.-B. Madeleine (2009)
+c
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "dimradmars.h"
+#include "tracer.h"
+
+c-----------------------------------------------------------------------
+c     Inputs:
+c     ------
+
+      INTEGER :: ngrid,nlayer
+c     Pressure between each layer (Pa)
+      REAL pplev(ngrid,nlayer+1)
+c     Pressure in the middle of each layer (Pa)
+      REAL pplay(ngrid,nlayer)
+c     Estimated ice crystal radius (m)
+      REAL :: rice(ngridmx,nlayermx)
+c     Estimated effective variance of the size distribution (n.u.)
+      REAL :: nuice(ngridmx,nlayermx)
+
+c     Outputs:
+c     -------
+
+c     Aerosol effective radius used for radiative transfer (meter)
+      REAL :: reffrad(ngridmx,nlayermx,naerkind)
+c     Aerosol effective variance used for radiative transfer (n.u.)
+      REAL :: nueffrad(ngridmx,nlayermx,naerkind)
+
+c     Local variables:
+c     ---------------
+
+      INTEGER :: ig,l                          ! 3D grid indices
+      INTEGER :: iaer                          ! Aerosol index
+
+c     Hyperbolic tangent function coefficients used to describe
+c       dust size vertical profile (reff=f(pplay))
+      REAL, PARAMETER :: dustcoefa = 0.10003736
+      REAL, PARAMETER :: dustcoefb = 0.77463902
+      REAL, PARAMETER :: dustcoefc = 3.1483479
+      REAL, PARAMETER :: dustcoefd = 2.4331281
+
+c     Local saved variables:
+c     ---------------------
+
+c==================================================================
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c         Particule size distribution computed below will be used
+c           only if there are more than one particule size in the
+c           ASCII file which contains the scattering parameters
+c           (see callradite.F for more information).
+c         Dust particle size distribution is deduced from dust 
+c           transport simulations. The resulting mean vertical size
+c           distribution is fitted with a function of the form
+c           f(x)= a+b*[1+tanh( (log(x)-c)/d )], f being the dust
+c           particle radius and x the atmospheric pressure
+c           in a given layer. Then it is used below to define a
+c           "background" dust size distribution.
+c         Effective variance is set to 0.3.
+
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              reffrad(ig,l,iaer)=(log(pplay(ig,l)) - dustcoefc) /
+     &                           dustcoefd
+              reffrad(ig,l,iaer)=max(( (1.E0 + 
+     &                                 tanh(reffrad(ig,l,iaer))) * 
+     &                                 dustcoefb + dustcoefa ) *
+     &                                 1E-6,1.E-9)
+              nueffrad(ig,l,iaer)=0.3
+            ENDDO
+          ENDDO
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              reffrad(ig,l,iaer)=rice(ig,l)
+              nueffrad(ig,l,iaer)=nuice(ig,l)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind
+      ENDDO ! iaer (loop on aerosol kind)
+
+      RETURN
+      END 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_cd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_cd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_cd.F	(revision 46)
@@ -0,0 +1,116 @@
+      SUBROUTINE vdif_cd( ngrid,nlay,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Subject: computation of the surface drag coefficient using the
+c   -------  approch developed by Loui for ECMWF.
+c
+c   Author: Frederic Hourdin  15 /10 /93
+c   -------
+c
+c   Arguments:
+c   ----------
+c
+c   inputs:
+c   ------
+c     ngrid            size of the horizontal grid
+c     pg               gravity (m s -2)
+c     pz(ngrid)        height of the first atmospheric layer
+c     pu(ngrid)        u component of the wind in that layer
+c     pv(ngrid)        v component of the wind in that layer
+c     pts(ngrid)       surfacte temperature
+c     ph(ngrid)        potential temperature T*(p/ps)^kappa
+c
+c   outputs:
+c   --------
+c     pcdv(ngrid)      Cd for the wind
+c     pcdh(ngrid)      Cd for potential temperature
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pz0
+      REAL pg,pz(ngrid,nlay)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay)
+      REAL pts(ngrid,nlay),ph(ngrid,nlay)
+      REAL pcdv(ngrid),pcdh(ngrid)
+
+c   Local:
+c   ------
+
+      INTEGER ig
+
+      REAL zu2,z1,zri,zcd0,zz
+
+      REAL karman,b,c,d,c2b,c3bc,c3b,umin2
+      LOGICAL firstcal
+      DATA karman,b,c,d,umin2/.4,5.,5.,5.,1.e-12/
+      DATA firstcal/.true./
+      SAVE b,c,d,karman,c2b,c3bc,c3b,firstcal,umin2
+
+c-----------------------------------------------------------------------
+c   couche de surface:
+c   ------------------
+
+c     DO ig=1,ngrid
+c        zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c        pcdv(ig)=pz0*(1.+sqrt(zu2))
+c        pcdh(ig)=pcdv(ig)
+c     ENDDO
+c     RETURN
+c
+c      IF (firstcal) THEN
+c         c2b=2.*b
+c         c3bc=3.*b*c
+c         c3b=3.*b
+c         firstcal=.false.
+c      ENDIF
+c
+c!!!! WARNING, verifier la formule originale de Louis!
+c      DO ig=1,ngrid
+c         zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c         zri=pg*pz(ig)*(ph(ig)-pts(ig))/(ph(ig)*zu2)
+c._.
+c            zri=0.E+0
+c._.
+c         z1=1.+pz(ig)/pz0
+c         zcd0=karman/log(z1)
+c._.         zcd0=zcd0*zcd0*sqrt(zu2)
+c         zcd0=zcd0*zcd0
+c         IF(zri.LT.0.) THEN
+c._.            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri))
+c            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri*zu2))
+c            pcdv(ig)=zcd0*(1.-2.*z1)
+c            pcdh(ig)=zcd0*(1.-3.*z1)
+c         ELSE
+c            zz=sqrt(1.+d*zri)
+c            pcdv(ig)=zcd0/(1.+c2b*zri/zz)
+c            pcdh(ig)=zcd0/(1.+c3b*zri*zz)
+c         ENDIF
+c      ENDDO
+
+
+c On calcule un VRAI cdrag tout bete
+
+      DO ig=1,ngrid
+         z1=1.E+0 + pz(ig,1)/pz0
+         zcd0=karman/log(z1)
+         zcd0=zcd0*zcd0
+         pcdv(ig)=zcd0
+         pcdh(ig)=zcd0
+      ENDDO
+
+       
+
+
+c-----------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_kc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_kc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdif_kc.F	(revision 46)
@@ -0,0 +1,554 @@
+      SUBROUTINE vdif_kc(dt,g,zlev,zlay,u,v,teta,cd,q2,km,kn)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphys.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g
+      REAL zlev(ngridmx,nlayermx+1)
+      REAL zlay(ngridmx,nlayermx)
+      REAL u(ngridmx,nlayermx)
+      REAL v(ngridmx,nlayermx)
+      REAL teta(ngridmx,nlayermx)
+      REAL cd(ngridmx)
+      REAL q2(ngridmx,nlayermx+1)
+      REAL km(ngridmx,nlayermx+1)
+      REAL kn(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(ngridmx,nlayermx)
+      REAL unsdzdec(ngridmx,nlayermx+1)
+      REAL q(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(ngridmx,nlayermx+1)
+      REAL qcstat
+      REAL q2cstat
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(ngridmx,nlayermx+1)
+      REAL mpre(ngridmx,nlayermx+1)
+      REAL m2(ngridmx,nlayermx+1)
+      REAL n2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(ngridmx,nlayermx+1)
+      REAL sn(ngridmx,nlayermx+1)
+      REAL snq2(ngridmx,nlayermx+1)
+      REAL sm(ngridmx,nlayermx+1)
+      REAL smq2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long0 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long0
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long0=160.E+0)
+      PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.E-3)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=nlayermx)
+      PARAMETER (nlev=nlayermx+1)
+      PARAMETER (ngrid=ngridmx)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+c                                                     DO igrid=1,ngrid 
+c           zlev(igrid,nlev)=zlay(igrid,nlay)
+c    &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+c                                                     ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdifc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdifc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vdifc.F	(revision 46)
@@ -0,0 +1,606 @@
+      SUBROUTINE vdifc(ngrid,nlay,nq,co2ice,ppopsk,
+     $                ptimestep,pcapcal,lecrit,
+     $                pplay,pplev,pzlay,pzlev,pz0,
+     $                pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     $                pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,
+     $                pdqdif,pdqsdif)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c   Turbulent diffusion (mixing) for potential T, U, V and tracer
+c
+c   Shema implicite
+c   On commence par rajouter au variables x la tendance physique
+c   et on resoult en fait:
+c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+c
+c   author:
+c   ------
+c      Hourdin/Forget/Fournier
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+
+#include "watercap.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+
+c    Argument added for condensation:
+      REAL co2ice (ngrid), ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+c    Traceurs :
+      integer nq 
+      REAL pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngridmx)
+      REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx),zcdh(ngridmx)
+      REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL ztsrf2(ngridmx)
+      REAL z1(ngridmx),z2(ngridmx)
+      REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx)
+      REAL zb0(ngridmx,nlayermx)
+      REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx)
+      REAL zcst1
+      REAL zu2
+
+      EXTERNAL SSUM,SCOPY
+      REAL SSUM
+      LOGICAL firstcall
+      SAVE firstcall
+
+c     variable added for CO2 condensation:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+      REAL hh , zhcond(ngridmx,nlayermx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond
+      SAVE acond,bcond
+      DATA latcond,tcond1mb/5.9e5,136.27/
+
+c    Tracers :
+c    ~~~~~~~ 
+      INTEGER iq
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq1temp(ngridmx)
+      REAL rho(ngridmx) ! near surface air density
+      REAL qsat(ngridmx)
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans vdifc'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+c        To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+         bcond=1./tcond1mb
+         acond=r/latcond
+         PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'          acond,bcond',acond,bcond
+
+        firstcall=.false.
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+      nlev=nlay+1
+
+c    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
+c       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
+c       ----------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(r*r)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s      (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s      (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+		 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
+      ENDDO
+
+c    ** diagnostique pour l'initialisation
+c       ----------------------------------
+
+      IF(lecrit) THEN
+         ig=ngrid/2+1
+         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
+         DO ilay=1,nlay
+            WRITE(*,'(6f11.5)')
+     s      .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
+     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
+         ENDDO
+         PRINT*,'Pression (mbar) ,altitude (km),zb'
+         DO ilev=1,nlay
+            WRITE(*,'(3f15.7)')
+     s      .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
+     s      zb0(ig,ilev)
+         ENDDO
+      ENDIF
+
+c     Potential Condensation temperature:
+c     -----------------------------------
+
+c     if (callcond) then 
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) =
+c    &  (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev)
+c         END DO
+c       END DO
+c     else
+        call zerophys(ngrid*nlay,zhcond)
+c     end if
+
+
+c-----------------------------------------------------------------------
+c   2. ajout des tendances physiques
+c      -----------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
+         ENDDO
+      ENDDO
+      if(tracer) then
+        DO iq =1, nq
+         DO ilev=1,nlay
+           DO ig=1,ngrid
+              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+c-----------------------------------------------------------------------
+c   3. schema de turbulence
+c      --------------------
+
+c    ** source d'energie cinetique turbulente a la surface
+c       (condition aux limites du schema de diffusion turbulente
+c       dans la couche limite
+c       ---------------------
+
+      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph
+     &             ,zcdv_true,zcdh_true)
+      DO ig=1,ngrid
+        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+c    ** schema de diffusion turbulente dans la couche limite
+c       ---------------------------------------------------- 
+
+        CALL vdif_kc(ptimestep,g,pzlev,pzlay
+     &              ,pu,pv,ph,zcdv_true
+     &              ,pq2,zkv,zkh)
+
+
+
+c    ** diagnostique pour le schema de turbulence
+c       -----------------------------------------
+
+      IF(lecrit) THEN
+         PRINT*
+         PRINT*,'Diagnostic for the vertical turbulent mixing'
+         PRINT*,'Cd for momentum and potential temperature'
+
+         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
+         PRINT*,'Mixing coefficient for momentum and pot.temp.'
+         DO ilev=1,nlay
+            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
+         ENDDO
+      ENDIF
+
+
+
+
+c-----------------------------------------------------------------------
+c   4. inversion pour l'implicite sur u
+c      --------------------------------
+
+c    ** l'equation est 
+c       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+c       avec
+c       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Ku
+ 
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   5. inversion pour l'implicite sur v
+c      --------------------------------
+
+c    ** l'equation est 
+c       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+c       avec
+c       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   6. inversion pour l'implicite sur h sans oublier le couplage
+c      avec le sol (conduction)
+c      ------------------------
+
+c    ** l'equation est 
+c       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+c       avec
+c       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+c       donc les entrees sont /zcdh/ pour la condition de raccord au sol
+c       et /zkh/ = Kh
+c       -------------
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+c    ** calcul de (d Planck / dT) a la temperature d'interface
+c       ------------------------------------------------------
+
+      z4st=4.*5.67e-8*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+c    ** calcul de la temperature_d'interface et de sa tendance.
+c       on ecrit que la somme des flux est nulle a l'interface
+c       a t + \delta t,
+c       c'est a dire le flux radiatif a {t + \delta t}
+c       + le flux turbulent a {t + \delta t} 
+c            qui s'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
+c            (notation K dt = /cpp*b/)        
+c       + le flux dans le sol a t
+c       + l'evolution du flux dans le sol lorsque la temperature d'interface
+c       passe de sa valeur a t a sa valeur a {t + \delta t}.
+c       ----------------------------------------------------
+
+      DO ig=1,ngrid
+         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
+     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
+         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
+         ztsrf2(ig)=z1(ig)/z2(ig)
+         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
+
+c        Modif speciale CO2 condensation:
+c        tconds = 1./(bcond-acond*log(.0095*pplev(ig,1)))
+c        if ((callcond).and.
+c    &      ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
+c           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
+c        else
+            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
+c        end if
+      ENDDO
+
+c    ** et a partir de la temperature au sol on remonte 
+c       -----------------------------------------------
+
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond
+            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+         ENDDO
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   TRACERS
+c   -------
+
+      if(tracer) then
+
+c     Using the wind modified by friction for lifting and  sublimation
+c     ----------------------------------------------------------------
+        DO ig=1,ngrid
+          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+        ENDDO
+
+c       Calcul du flux vertical au bas de la premiere couche (dust) :
+c       -----------------------------------------------------------
+        do ig=1,ngridmx  
+          rho(ig) = zb0(ig,1) /ptimestep
+!          zb(ig,1) = 0.
+        end do
+c       Dust lifting:
+        if (lifting) then 
+           call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     $                  pdqsdif)
+       
+        else
+           call zerophys(ngrid*nq,pdqsdif)
+        end if
+
+c       OU calcul de la valeur de q a la surface (water)  :
+c       ----------------------------------------
+        if (water) then 
+            call watersat(ngridmx,ptsrf,pplev(1,1),qsat)
+        end if
+
+c      Inversion pour l'implicite sur q 
+c       --------------------------------
+        do iq=1,nq
+          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+
+          if ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c            This line is required to account for turbulent transport 
+c            from surface (e.g. ice) to mid-layer of atmosphere:
+             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
+             CALL multipl(ngrid,dryness,zb(1,1),zb(1,1)) 
+          else ! (re)-initialize zb(:,1)
+             zb(1:ngrid,1)=0
+          end if
+
+          DO ig=1,ngrid
+               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+          ENDDO
+  
+          DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+               ENDDO
+          ENDDO
+
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            ! special case for water ice tracer: do not include
+            ! h2o ice tracer from surface (which is set when handling
+            ! h2o vapour case (see further down).
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2)) *z1(ig)
+            ENDDO
+          else ! general case
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2) +
+     $        (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
+            ENDDO
+          endif ! of if (water.and.(iq.eq.igcm_h2o_ice))
+  
+          IF ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c           Calculation for turbulent exchange with the surface (for ice)
+            DO ig=1,ngrid
+              zd(ig,1)=zb(ig,1)*z1(ig)
+              zq1temp(ig)=zc(ig,1)+ zd(ig,1)*qsat(ig)
+
+              pdqsdif(ig,igcm_h2o_ice)=rho(ig)*dryness(ig)*zcdv(ig)
+     &                       *(zq1temp(ig)-qsat(ig))
+c             write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+            END DO
+
+            DO ig=1,ngrid
+              if(.not.watercaptag(ig)) then
+                if ((-pdqsdif(ig,igcm_h2o_ice)*ptimestep)
+     &             .gt.pqsurf(ig,igcm_h2o_ice)) then
+c                 write(*,*)'on sublime plus que qsurf!'
+                  pdqsdif(ig,igcm_h2o_ice)=
+     &                         -pqsurf(ig,igcm_h2o_ice)/ptimestep
+c                 write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
+                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_h2o_vap)+
+     $            zb(ig,2)*zc(ig,2) +
+     $            (-pdqsdif(ig,igcm_h2o_ice)) *ptimestep) *z1(ig)
+                  zq1temp(ig)=zc(ig,1)
+                endif   
+              endif ! if (.not.watercaptag(ig))
+c             Starting upward calculations for water :
+               zq(ig,1,igcm_h2o_vap)=zq1temp(ig)
+            ENDDO ! of DO ig=1,ngrid
+          ELSE
+c           Starting upward calculations for simple mixing of tracer (dust)
+            DO ig=1,ngrid
+               zq(ig,1,iq)=zc(ig,1)
+            ENDDO
+          END IF ! of IF ((water).and.(iq.eq.igcm_h2o_vap))
+
+          DO ilay=2,nlay
+             DO ig=1,ngrid
+                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
+             ENDDO
+          ENDDO
+        enddo ! of do iq=1,nq
+      end if ! of if(tracer)
+
+c-----------------------------------------------------------------------
+c   8. calcul final des tendances de la diffusion verticale
+c      ----------------------------------------------------
+
+      DO ilev = 1, nlay
+         DO ig=1,ngrid
+            pdudif(ig,ilev)=(    zu(ig,ilev)-
+     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
+            pdvdif(ig,ilev)=(    zv(ig,ilev)-
+     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
+            hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,
+     $           zhcond(ig,ilev))        ! modif co2cond
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         ENDDO
+      ENDDO
+
+    
+      if (tracer) then 
+        DO iq = 1, nq
+          DO ilev = 1, nlay
+            DO ig=1,ngrid
+              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     $      (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        ENDDO
+      end if
+
+c    ** diagnostique final 
+c       ------------------
+
+      IF(lecrit) THEN
+         PRINT*,'In vdif'
+         PRINT*,'Ts (t) and Ts (t+st)'
+         WRITE(*,'(a10,3a15)')
+     s   'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
+         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
+         DO ilev=1,nlay
+            WRITE(*,'(4f15.7)')
+     s      ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev),
+     s      pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
+
+         ENDDO
+      ENDIF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vlz_fi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vlz_fi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/vlz_fi.F	(revision 46)
@@ -0,0 +1,195 @@
+      SUBROUTINE vlz_fi(ngrid,q,pente_max,masse,w,wq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " dans la verticale
+c    pour appel dans la physique (sedimentation)
+c    ********************************************************************
+c    q rapport de melange (kg/kg)...
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "dimphys.h"
+
+c
+c
+c   Arguments:
+c   ----------
+      integer ngrid
+      real masse(ngrid,llm),pente_max
+      REAL q(ngrid,llm)
+      REAL w(ngrid,llm)
+      REAL wq(ngrid,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+
+      real dzq(ngridmx,llm),dzqw(ngridmx,llm),adzqw(ngridmx,llm),dzqmax
+      real newmasse
+      real sigw, Mtot, MQtot
+      integer m
+
+      REAL      SSUM,CVMGP,CVMGT
+      integer ismax,ismin
+
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+      do l=2,llm
+         do ij=1,ngrid
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         enddo
+      enddo
+
+      do l=2,llm-1
+         do ij=1,ngrid
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            if(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) then
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            else
+                dzq(ij,l)=0.
+            endif
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         enddo
+      enddo
+
+      do ij=1,ngrid
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      enddo
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+c
+c      No flux at the model top:
+       do ij=1,ngrid
+          wq(ij,llm+1)=0.
+       enddo
+
+c      1) Compute wq where w > 0 (down) (ALWAYS FOR SEDIMENTATION)     
+c      ===============================
+
+       do l = 1,llm          ! loop different than when w<0
+        do  ij = 1,ngrid
+
+         if(w(ij,l).gt.0.)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(ij,l).le.masse(ij,l))then
+            sigw=w(ij,l)/masse(ij,l)
+            wq(ij,l)=w(ij,l)*(q(ij,l)+0.5*(1.-sigw)*dzq(ij,l))
+            
+
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+            m=l
+            Mtot = masse(ij,m)
+            MQtot = masse(ij,m)*q(ij,m)
+            if(m.ge.llm)goto 88
+            do while(w(ij,l).gt.(Mtot+masse(ij,m+1)))
+                m=m+1
+                Mtot = Mtot + masse(ij,m)
+                MQtot = MQtot + masse(ij,m)*q(ij,m)
+                if(m.ge.llm)goto 88
+            end do
+ 88         continue
+            if (m.lt.llm) then
+                sigw=(w(ij,l)-Mtot)/masse(ij,m+1)
+                wq(ij,l)=(MQtot + (w(ij,l)-Mtot)*
+     &          (q(ij,m+1)+0.5*(1.-sigw)*dzq(ij,m+1)) )
+            else
+                w(ij,l) = Mtot
+                wq(ij,l) = Mqtot 
+            end if
+          end if
+         end if
+        enddo
+       enddo
+
+c      2) Compute wq where w < 0 (up) (NOT USEFUL FOR SEDIMENTATION)     
+c      ===============================
+       goto 99 ! SKIPPING THIS PART FOR SEDIMENTATION 
+
+c      Surface flux up:
+       do  ij = 1,ngrid
+         if(w(ij,1).lt.0.) wq(ij,1)=0. ! warning : not always valid
+       end do
+
+       do l = 1,llm-1  ! loop different than when w>0
+        do  ij = 1,ngrid
+         if(w(ij,l+1).le.0)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(-w(ij,l+1).le.masse(ij,l))then
+            sigw=w(ij,l+1)/masse(ij,l)
+            wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+             m = l-1
+             Mtot = masse(ij,m+1)
+             MQtot = masse(ij,m+1)*q(ij,m+1)
+             if (m.le.0)goto 77
+             do while(-w(ij,l+1).gt.(Mtot+masse(ij,m)))
+                m=m-1
+                Mtot = Mtot + masse(ij,m+1)
+                MQtot = MQtot + masse(ij,m+1)*q(ij,m+1)
+                if (m.le.0)goto 77
+             end do
+ 77          continue
+
+             if (m.gt.0) then
+                sigw=(w(ij,l+1)+Mtot)/masse(ij,m)
+                wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*
+     &          (q(ij,m)-0.5*(1.+sigw)*dzq(ij,m))  )
+             else
+c               wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*qm(ij,1))
+                write(*,*) 'a rather weird situation in vlz_fi !'
+                stop
+             end if
+          endif
+         endif
+        enddo
+       enddo
+ 99    continue
+
+      do l=1,llm
+         do ij=1,ngrid
+
+cccccccc lines below not used for sedimentation (No real flux)
+ccccc       newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l) 
+ccccc       q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+ccccc&         /newmasse
+ccccc       masse(ij,l)=newmasse
+
+            q(ij,l)=q(ij,l) +  (wq(ij,l+1)-wq(ij,l))/masse(ij,l)
+
+         enddo
+      enddo
+
+
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercap.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercap.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercap.h	(revision 46)
@@ -0,0 +1,6 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'watercap.h'
+
+      logical watercaptag(ngridmx)
+
+      common/permcap/watercaptag
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercloud.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercloud.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watercloud.F	(revision 46)
@@ -0,0 +1,351 @@
+       SUBROUTINE watercloud(ngrid,nlay, ptimestep, 
+     &                pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
+     &                pq,pdq,pdqcloud,pdqscloud,pdtcloud,
+     &                nq,naersize,tau,
+     &                rnuclei,rice,nuice)
+      IMPLICIT NONE
+
+c=======================================================================
+c     Treatment of saturation of water vapor
+c
+c
+c     Modif de zq si saturation dans l'atmopshere
+c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+c     Le test est effectue de bas en haut. L'eau condensee
+c    (si saturation) est remise dans la couche en dessous.
+c     L'eau condensee dans la couche du bas est deposee a la surface
+c       
+c    Modification: Franck Montmessin water ice scheme
+c                  Francois Forget : change nuclei density & outputs   
+c                  Ehouarn Millour: sept.2008, tracers are now handled
+c                                   by name (and not fixed index)
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "comgeomfi.h"
+
+c   Inputs:
+c   ------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep             ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pplay(ngrid,nlay)     ! pression au milieu des couches (Pa)
+      REAL pdpsrf(ngrid)         ! tendance surf pressure
+      REAL pzlev(ngrid,nlay+1)   ! altitude at layer boundaries
+      REAL pzlay(ngrid,nlay)     ! altitude at the middle of the layers
+      REAL pt(ngrid,nlay)        ! temperature at the middle of the layers (K)
+      REAL pdt(ngrid,nlay)       ! tendance temperature des autres param.
+
+      real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
+      real pdq(ngrid,nlay,nq)    ! tendance avant condensation  (kg/kg.s-1)
+
+      integer nq         ! nombre de traceurs 
+      integer naersize   ! nombre de traceurs radiativement actifs (=naerkind)
+      REAL tau(ngridmx,naersize)
+
+c   Outputs:
+c   -------
+
+      real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1)
+      real pdqscloud(ngrid,nq)     ! flux en surface (kg.m-2.s-1)
+      REAL pdtcloud(ngrid,nlay)    ! tendance temperature due a la chaleur latente
+
+      REAL rnuclei(ngrid,nlay) ! Prescribed dust radius in each
+                               !   layer (m)
+      REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngrid,nlay)   ! Estimated effective variance
+                               !   of the size distribution
+
+c   local:
+c   ------
+
+      REAL CBRT
+      EXTERNAL CBRT
+      INTEGER ig,iq,l
+
+
+      REAL zq(ngridmx,nlayermx,nqmx)  ! local value of tracers
+      REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers
+      REAL zqsat(ngridmx,nlayermx)    ! saturation
+      REAL zt(ngridmx,nlayermx)       ! local value of temperature
+
+
+      REAL masse (ngridmx,nlayermx)
+      REAL epaisseur (ngridmx,nlayermx)
+      REAL dustcores(ngridmx,nlayermx)  !Dust number density (#/kg) 
+      REAL rfinal        ! Ice crystal radius after condensation(m)
+      REAL seq           ! Equilibrium saturation ration (accounting for curvature effect)
+      REAL dzq           ! masse de glace echangee (kg/kg)
+      REAL lw       !Latent heat of sublimation (J.kg-1) 
+      REAL,PARAMETER :: To=273.15 ! reference temperature, T=273.15 K
+
+      REAL Ctot
+      REAL*8 ph2o,satu
+      REAL gr,Cste,up,dwn,newvap
+
+      LOGICAL,SAVE :: firstcall=.true.
+! To use more refined microphysics, set improved to .true. 
+      LOGICAL,PARAMETER :: improved=.true.
+
+
+c     Pour diagnostique :
+c     ~~~~~~~~~~~~~~~~~
+c     REAL icetot(ngridmx)             ! Total mass of water ice (kg/m2)
+c     REAL rave(ngridmx)               ! Mean crystal radius in a column (m)
+
+      INTEGER i
+
+! indexes of water vapour, water ice and dust tracers:
+      INTEGER,SAVE :: i_dust=0 ! dust
+      INTEGER,SAVE :: i_h2o=0  ! water vapour
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+        IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans watercloud'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+        ENDIF
+         
+        if (nq.gt.nqmx) then
+           write(*,*) 'stop in watercloud (nq.gt.nqmx)!'
+           write(*,*) 'nq=',nq,' nqmx=',nqmx
+           stop
+        endif
+         
+        do iq=1,nqmx
+          tracername=noms(iq)
+          if (tracername(1:4).eq."dust") then
+            i_dust=iq
+          endif
+!          if (tracername.eq."h2o_ice") then
+!            i_ice=iq
+!          endif
+!          if (tracername.eq."h2o_vap") then
+!            i_h2o=iq
+!          endif
+        enddo
+        i_h2o=igcm_h2o_vap
+        i_ice=igcm_h2o_ice
+        
+        write(*,*) "watercloud: i_dust=",i_dust
+        write(*,*) "            i_ice=",i_ice
+        write(*,*) "            i_h2o=",i_h2o
+        
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q(nqmx) (water vapor) et temperature.
+c    On effectue qqes calculs preliminaires sur les couches : 
+c    masse (kg.m-2), epaisseur(m).
+
+      do l=1,nlay
+        do ig=1,ngrid
+          zq(ig,l,i_h2o)=pq(ig,l,i_h2o)+pdq(ig,l,i_h2o)*ptimestep
+          zq(ig,l,i_h2o)=max(zq(ig,l,i_h2o),1.E-30) ! FF 12/2004 
+          zq0(ig,l,i_h2o)=zq(ig,l,i_h2o)
+          zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+          epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
+
+          zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
+          zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 
+          zq0(ig,l,i_ice)=zq(ig,l,i_ice)
+          rnuclei(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+c         Calcul du rayon moyen des particules de glace.
+c         Hypothese : Dans une couche, la glace presente se
+c         repartit uniformement autour du nbre de poussieres
+c         dont le rayon moyen est prescrit par rnuclei.
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if ((dustbin.eq.1).and.(.not.(doubleq))) then
+            zq(ig,l,i_dust)=pq(ig,l,i_dust)+pdq(ig,l,i_dust)*ptimestep
+              dustcores(ig,l)=max(zq(ig,l,i_dust)/
+     &         (rho_dust*4./3.*pi*radius(i_dust)**3.),1.e-9)
+          else
+            dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+     &     2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+
+c            TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+c              dustcores(ig,l) = dustcores(ig,l) / 27. ! reduction facteur 3
+            dustcores(ig,l) = dustcores(ig,l) / 8. ! reduction facteur 2
+          endif
+          rice(ig,l)=CBRT( ( zq(ig,l,i_ice)/rho_ice+
+     &       dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3. )
+     &       / (dustcores(ig,l)*4./3.*pi) )
+          rice(ig,l)=max(rice(ig,l),rnuclei(ig,l))
+c         Effective variance of the size distribution
+          nuice(ig,l)=0.1
+        enddo ! of do ig=1,ngrid
+      enddo ! of dol=1,nlay
+
+      call zerophys(ngrid*nq,pdqscloud)
+      call zerophys(ngrid*nlay*nq,pdqcloud)
+      call zerophys(ngrid*nlay,pdtcloud)
+
+c     call zerophys(ngrid,icetot)
+c     call zerophys(ngrid,rave)
+
+c    ----------------------------------------------
+c
+c
+c       Rapport de melange a saturation dans la couche l : -------
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        call watersat(ngridmx*nlayermx,zt,pplay,zqsat)
+
+c       taux de condensation (kg/kg/s-1) dans les differentes couches
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       Iceparty is not used anymore: water=>iceparty (JBM).
+c       if(iceparty) then
+
+        do l=1,nlay
+          do ig=1,ngrid
+
+          IF (improved) then
+c         Improved microphysics scheme
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           Ctot = zq(ig,l,i_h2o) + zq(ig,l,i_ice)
+           ph2o = zq(ig,l,i_h2o) * 44. / 18. * pplay(ig,l)
+           satu = zq(ig,l,i_h2o) / zqsat(ig,l)
+
+           call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+     &        ph2o,ph2o/satu,seq,rice(ig,l),gr)
+           Cste = ptimestep * 4. * pi * rice(ig,l)
+     *              * rho_ice * dustcores(ig,l)
+           up   = zq(ig,l,i_h2o) + Cste * gr * seq
+           dwn  =    1.       + Cste * gr / zqsat(ig,l)
+           newvap = min(up/dwn,Ctot)
+
+           gr  = gr * ( newvap/zqsat(ig,l) - seq )
+           dzq = min( max( Cste * gr,-zq(ig,l,i_ice) ) 
+     *             , zq(ig,l,i_h2o) )
+
+c          Nucleation (sat ratio must be larger than a critical value)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           if (satu.gt.1.) then
+             if (satu.le.1.4.and.zq(ig,l,i_ice).lt.1.e-8) 
+     *          dzq = 0.
+           endif
+
+           ELSE
+c          Old version
+c          ~~~~~~~~~~~
+           if (zq(ig,l,i_h2o).ge.zqsat(ig,l))then  !  Condensation
+             dzq=zq(ig,l,i_h2o)-zqsat(ig,l)                
+           elseif(zq(ig,l,i_h2o).lt.zqsat(ig,l))then  ! Sublimation
+             dzq=-min(zqsat(ig,l)-zq(ig,l,i_h2o),zq(ig,l,i_ice))
+           endif
+
+           ENDIF ! of IF (improved)
+
+c           Water Mass change
+c           ~~~~~~~~~~~~~~~~~
+            zq(ig,l,i_ice)=zq(ig,l,i_ice)+dzq
+            zq(ig,l,i_h2o)=zq(ig,l,i_h2o)-dzq
+
+            rice(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_ice
+     &       +dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3.)
+     &       /(dustcores(ig,l)*4./3.*pi) ), rnuclei(ig,l)) 
+
+            enddo ! of do ig=1,ngrid
+          enddo ! of do l=1,nlay
+
+c       The following part have been commented because iceparty
+c           is not used anymore: water=>iceparty (JBM).
+
+c       else   ! if not iceparty
+
+c         Saturation couche nlay a 2 :
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         do l=nlay,2, -1
+c          do ig=1,ngrid
+c           if (zq(ig,l,i_h2o).gt.zqsat(ig,l))then 
+c             zq(ig,l-1,i_h2o)= zq(ig,l-1,i_h2o)+
+c    &                          (zq(ig,l,i_h2o)-zqsat(ig,l))
+c    &          *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+c             zq(ig,l,i_h2o)=zqsat(ig,l)
+c           endif
+c          enddo
+c         enddo
+
+c       Saturation couche l=1 si pas iceparty 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         do ig=1,ngridmx
+c           if (zq(ig,1,i_h2o).gt.zqsat(ig,1))then
+c             pdqscloud(ig,i_ice)=(zq(ig,1,i_h2o)-zqsat(ig,1))
+c    &           *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep)
+c             zq(ig,1,i_h2o)=zqsat(ig,1)
+c           endif
+c         enddo
+
+c       endif   ! of if (iceparty)
+
+c       Tendance finale
+c       ~~~~~~~~~~~~~~~
+        do l=1, nlay
+          do ig=1,ngridmx
+            pdqcloud(ig,l,i_h2o)=(zq(ig,l,i_h2o)
+     &                              -zq0(ig,l,i_h2o))/ptimestep
+            pdqcloud(ig,l,i_ice) =
+     &        (zq(ig,l,i_ice) - zq0(ig,l,i_ice))/ptimestep
+            lw=(2834.3-0.28*(zt(ig,l)-To)-0.004*(zt(ig,l)-To)**2)*1.e+3
+            pdtcloud(ig,l)=-pdqcloud(ig,l,i_h2o)*lw/cpp
+          end do 
+        end do
+
+c       A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       Then that should not affect the ice particle radius
+        do ig=1,ngridmx
+          if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,2)))then
+            if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,3)))
+     &      rice(ig,2)=rice(ig,3) 
+            rice(ig,1)=rice(ig,2)
+          end if
+        end do
+        
+c**************************************************
+c       Output  
+c**************************************************
+! NB: for diagnostics use zq(), the updated value of tracers
+
+c        do ig=1,ngridmx
+c         do l=1 ,nlay
+c           masse de glace d'eau dans la couche l
+c           icetot(ig)=icetot(ig)+masse(ig,l)*zq(ig,l,i_ice)
+c           rayon moyen des cristaux dans la colonne ig
+c           rave(ig)=rave(ig)+masse(ig,l)*zq(ig,l,i_ice)*rice(ig,l)
+c         enddo
+c         rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+c         if (icetot(ig)*1000.lt.0.01) rave(ig)=0.
+c        enddo   ! (ngridmx)
+c**************************************************
+
+ 99   continue
+
+      RETURN
+      END
+ 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watersat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watersat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/watersat.F	(revision 46)
@@ -0,0 +1,47 @@
+      SUBROUTINE watersat(naersize,t,p,qsat)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Water mass mixing ratio at saturation (kg/kg) for a given pressure (Pa)
+c   and Temperature (K) array
+c
+c=======================================================================
+
+c   declarations:
+c   -------------
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer naersize 
+      real t(naersize) , p(naersize)
+c   OUTPUT
+      real qsat(naersize)
+
+c   local:
+c   ------
+      INTEGER i
+      REAL r2,r3,r4 , To, es
+      SAVE r2,r3,r4
+      DATA r2,r3,r4/611.14,21.875,7.66/
+      SAVE To
+      DATA To/273.16/
+          
+      do i=1,naersize
+c        pression de vapeur saturante :
+c         es =r2*exp(r3*(t(i)-To)/(t(i)-r4))
+c         qsat(i)=es/p(i)*0.41  !rapport de melange
+        es=2.07023-0.00320991*t(i)-2484.896/t(i)+3.56654*alog10(t(i))
+        es=10.**es 
+        qsat(i)=(es*100.)/p(i)*0.41 
+
+c        qss = specific humidity
+c        qss=622*10**(2.07023-0.0032991*Tsurf(ig)-2484.896/Tsurf(ig)
+c    $                  +3.56654*log10(Tsurf(ig)))
+
+      enddo
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagfi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagfi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagfi.F	(revision 46)
@@ -0,0 +1,405 @@
+      subroutine writediagfi(ngrid,nom,titre,unite,dim,px)
+
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
+!  La periode d'ecriture est donnee par 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 1, 2, ou 3d)
+!      dim : dimension de px : 0, 1, 2, ou 3 dimensions
+!
+!=================================================================
+ 
+      implicit none
+
+! Commons
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "netcdf.inc"
+#include "temps.h"
+#include "surfdat.h"
+
+! Arguments on input:
+      integer ngrid
+      character (len=*) :: nom,titre,unite
+      integer dim
+      real px(ngrid,llm)
+
+! Local variables:
+
+      real dx3(iip1,jjp1,llm) ! to store a 3D data set
+      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+      real dx1(llm)           ! to store a 1D (column) data set
+      real dx0
+
+      real date
+
+      REAL phis(ip1jmp1)
+
+      integer irythme
+      integer ierr
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer zitau
+      character firstnom*20
+      SAVE firstnom
+      SAVE zitau
+      SAVE date
+      data firstnom /'1234567890'/
+      data zitau /0/
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character (len =50):: fichnom
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+      
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = int(ecritphy) ! sortie au rythme de ecritphy
+!     irythme = iconser  ! sortie au rythme des variables de controle
+!     irythme = iphysiq  ! sortie a tous les pas physique
+!     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
+!     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
+
+!***************************************************************
+
+
+! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+! ------------------------------------------------------------------------
+! (Au tout premier appel de la subroutine durant le run.)
+
+      fichnom="diagfi.nc"
+
+      if (firstnom.eq.'1234567890') then ! .true. for the very first call
+      !  to this subroutine; now set 'firstnom'
+         firstnom = nom
+         ! just to be sure, check that firstnom is large enough to hold nom
+         if (len_trim(firstnom).lt.len_trim(nom)) then
+           write(*,*) "writediagfi: Error !!!"
+           write(*,*) "   firstnom string not long enough!!"
+           write(*,*) "   increase its size to at least ",len_trim(nom)
+           stop
+         endif
+
+         ! Create the NetCDF file
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+         ! Define the 'Time' dimension
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+         ! Define the 'Time' variable
+#ifdef NC_DOUBLE
+         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+#endif
+         ! Add a long_name attribute
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ! Add a units attribute
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ! Switch out of NetCDF Define mode
+         ierr = NF_ENDDEF(nid)
+
+         ! write "header" of file (longitudes, latitudes, geopotential, ...)
+         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
+         call iniwrite(nid,day_ini,phis)
+         
+         zitau = -1 ! initialize zitau
+      else
+         ! Open the NetCDF file
+         ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+      endif ! if (firstnom.eq.'1234567890')
+
+      if (ngridmx.eq.1) then
+        ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
+        ! are undefined; so set them to 1
+        iphysiq=1 
+        irythme=1
+        ! NB: 
+      endif
+
+! Increment time index 'zitau' if it is the "fist call" (at given time level)
+! to writediagfi
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          zitau = zitau + iphysiq
+      end if
+
+!--------------------------------------------------------
+! Write the variables to output file if it's time to do so
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+! Compute/write/extend 'Time' coordinate (date given in days)
+! (done every "first call" (at given time level) to writediagfi)
+! Note: date is incremented as 1 step ahead of physics time
+!--------------------------------------------------------
+
+        if (nom.eq.firstnom) then
+        ! We have identified a "first call" (at given date)
+           ntime=ntime+1 ! increment # of stored time steps
+           ! compute corresponding date (in days and fractions thereof)
+           date= float (zitau +1)/float (day_step)
+           ! Get NetCDF ID of 'Time' variable
+           ierr= NF_INQ_VARID(nid,"Time",varid)
+           ! Write (append) the new date to the 'Time' array
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+           endif
+
+           write(6,*)'WRITEDIAGFI: date= ', date
+        end if ! of if (nom.eq.firstnom)
+
+!Case of a 3D variable
+!---------------------
+        if (dim.eq.3) then
+
+!         Passage variable physique -->  variable dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+           DO l=1,llm
+             DO i=1,iip1
+                dx3(i,1,l)=px(1,l)
+                dx3(i,jjp1,l)=px(ngrid,l)
+             ENDDO
+             DO j=2,jjm
+                ig0= 1+(j-2)*iim
+                DO i=1,iim
+                   dx3(i,j,l)=px(ig0+i,l)
+                ENDDO
+                dx3(iip1,j,l)=dx3(1,j,l)
+             ENDDO
+           ENDDO
+
+!         Ecriture du champs
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+! name of the variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif 
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Case of a 2D variable
+!---------------------
+
+        else if (dim.eq.2) then
+
+!         Passage variable physique -->  physique dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+
+             DO i=1,iip1
+                dx2(i,1)=px(1,1)
+                dx2(i,jjp1)=px(ngrid,1)
+             ENDDO
+             DO j=2,jjm
+                ig0= 1+(j-2)*iim
+                DO i=1,iim
+                   dx2(i,j)=px(ig0+i,1)
+                ENDDO
+                dx2(iip1,j)=dx2(1,j)
+             ENDDO
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Case of a 1D variable (ie: a column)
+!---------------------------------------------------
+
+       else if (dim.eq.1) then
+!         Passage variable physique -->  physique dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+          do l=1,llm
+            dx1(l)=px(1,l)
+          enddo
+          
+          ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"altitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"Time",id(2))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,2,id,varid,ierr)
+              
+           endif
+           
+           corner(1)=1
+           corner(2)=ntime
+           
+           edges(1)=llm
+           edges(2)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Case of a 0D variable (ie: a time-dependent scalar)
+!---------------------------------------------------
+
+        else if (dim.eq.0) then
+           dx0 = px (1,1)
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+        endif ! of if (dim.eq.3) elseif(dim.eq.2)...
+
+      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
+
+      ierr= NF_CLOSE(nid)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagsoil.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagsoil.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writediagsoil.F90	(revision 46)
@@ -0,0 +1,270 @@
+subroutine writediagsoil(ngrid,name,title,units,dimpx,px)
+
+! Write variable 'name' to NetCDF file 'diagsoil.nc'.
+! The variable may be 3D (lon,lat,depth) subterranean field,
+! a 2D (lon,lat) surface field, or a simple scalar (0D variable).
+!
+! Calls to 'writediagsoil' can originate from anywhere in the program;
+! An initialisation of variable 'name' is done if it is the first time
+! that this routine is called with given 'name'; otherwise data is appended
+! (yielding the sought time series of the variable)
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"paramet.h"
+#include"control.h"
+#include"comsoil.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid
+! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm
+character(len=*),intent(in) :: name ! 'name' of the variable
+character(len=*),intent(in) :: title ! 'long_name' attribute of the variable
+character(len=*),intent(in) :: units ! 'units' attribute of the variable
+integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0)
+real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable
+! Note: nsoilmx is a common parameter set in 'dimphys.h'
+
+! Local variables:
+real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h
+real,dimension(iip1,jjp1) :: data2 ! to store 2D data
+real :: data0 ! to store 0D data
+integer :: i,j,l ! for loops
+integer :: ig0
+
+real,save :: date ! time counter (in elapsed days)
+integer,save :: isample ! sample rate at which data is to be written to output
+integer,save :: ntime=0 ! counter to internally store time steps
+character(len=20),save :: firstname="1234567890"
+integer,save :: zitau=0
+
+character(len=30) :: filename="diagsoil.nc"
+
+! NetCDF stuff:
+integer :: nid ! NetCDF output file ID
+integer :: varid ! NetCDF ID of a variable
+integer :: ierr ! NetCDF routines return code
+integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable
+integer,dimension(4) :: edges,corners
+
+! 1. Initialization step
+if (firstname.eq."1234567890") then
+  ! Store 'name' as 'firstname'
+  firstname=name
+  ! From now on, if 'name'.eq.'firstname', then it is a new time cycle
+
+  ! just to be sure, check that firstnom is large enough to hold nom
+  if (len_trim(firstname).lt.len_trim(name)) then
+    write(*,*) "writediagsoil: Error !!!"
+    write(*,*) "   firstname string not long enough!!"
+    write(*,*) "   increase its size to at least ",len_trim(name)
+    stop
+  endif
+  
+  ! Set output sample rate
+  isample=int(ecritphy) ! same as for diagfi outputs
+  ! Note ecritphy is known from control.h
+  
+  ! Create output NetCDF file
+  ierr=NF_CREATE(filename,NF_CLOBBER,nid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*)'writediagsoil: Error, failed creating file '//trim(filename)
+    stop
+  endif
+  
+  ! Define dimensions and axis attributes
+  call iniwritesoil(nid)
+  
+  ! set zitau to -1 to be compatible with zitau incrementation step below
+  zitau=-1
+  
+else
+  ! If not an initialization call, simply open the NetCDF file
+  ierr=NF_OPEN(filename,NF_WRITE,nid)
+endif ! of if (firstname.eq."1234567890")
+
+! 2. Increment local time counter, if necessary
+if (name.eq.firstname) then
+  ! if we run across 'firstname', then it is a new time step
+  zitau=zitau+iphysiq
+  ! Note iphysiq is known from control.h
+endif
+
+! 3. Write data, if the time index matches the sample rate
+if (mod(zitau+1,isample).eq.0) then
+
+! 3.1 If first call at this date, update 'time' variable
+  if (name.eq.firstname) then
+    ntime=ntime+1
+    date=float(zitau+1)/float(day_step)
+    ! Note: day_step is known from control.h
+    
+    ! Get NetCDF ID for "time"
+    ierr=NF_INQ_VARID(nid,"time",varid)
+    ! Add the current value of date to the "time" array
+#ifdef NC_DOUBLE
+    ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+    ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*)"writediagsoil: Failed writing date to time variable"
+      stop 
+    endif
+  endif ! of if (name.eq.firstname)
+
+! 3.2 Write the variable to the NetCDF file
+if (dimpx.eq.3) then ! Case of a 3D variable
+  ! A. Recast data along 'dynamics' grid
+  do l=1,nsoilmx
+    ! handle the poles
+    do i=1,iip1
+      data3(i,1,l)=px(1,l)
+      data3(i,jjp1,l)=px(ngrid,l)
+    enddo
+    ! rest of the grid
+    do j=2,jjm
+      ig0=1+(j-2)*iim
+      do i=1,iim
+        data3(i,j,l)=px(ig0+i,l)
+      enddo
+      data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+    enddo
+  enddo
+  
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"depth",id(3))
+    ierr=NF_INQ_DIMID(nid,"time",id(4))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,4,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+  
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=1
+  corners(4)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=nsoilmx
+  edges(4)=1
+  
+  ! B.3. Write the slab of data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+elseif (dimpx.eq.2) then ! Case of a 2D variable
+  ! A. Recast data along 'dynamics' grid
+  ! handle the poles
+  do i=1,iip1
+    data2(i,1)=px(1,1)
+    data2(i,jjp1)=px(ngrid,1)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data2(i,j)=px(ig0+i,1)
+    enddo
+    data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
+  enddo
+
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"time",id(3))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,3,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=1
+  
+  ! B.3. Write the slab of data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+elseif (dimpx.eq.0) then ! Case of a 0D variable
+  ! A. Copy data value
+  data0=px(1,1)
+
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"time",id(1))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,1,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=ntime
+  
+  edges(1)=1
+
+  ! B.3. Write the data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ...
+endif ! of if (mod(zitau+1,isample).eq.0)
+
+! 4. Close the NetCDF file
+ierr=NF_CLOSE(nid)
+
+end subroutine writediagsoil
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writeg1d.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writeg1d.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/writeg1d.F	(revision 46)
@@ -0,0 +1,204 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+      REAL*4 xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+c
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        g1d_premier=.false.
+      ENDIF
+c
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+c
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+c
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+      ivar =min( max(int(1440.*dtphys/daysec +0.5),1) , 99)   
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/wstats.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/wstats.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/wstats.F90	(revision 46)
@@ -0,0 +1,279 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*) :: nom,titre,unite
+integer,intent(in) :: dim
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real, dimension(ngrid,llm) :: px
+real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+character (len=50) :: namebis
+character (len=50), save :: firstvar
+integer :: ierr,varid,nbdim,nid
+integer :: meanid,sdid
+integer, dimension(4)  :: id,start,size
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: index
+
+integer, save :: step=0
+
+
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+   RETURN
+endif
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+
+   if (firstvar==nom) then 
+      index=1
+      count=0
+   endif
+
+
+!declaration de la variable
+
+! choix du nom des coordonnees
+   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+   if (dim.eq.3) then
+      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+      ierr= NF_INQ_DIMID(nid,"Time",id(4))
+      nbdim=4
+   else if (dim==2) then
+      ierr= NF_INQ_DIMID(nid,"Time",id(3))
+      nbdim=3
+   endif
+
+   write (*,*) "====================="
+   write (*,*) "STATS: creation de ",nom
+   namebis=trim(nom)
+   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   namebis=trim(nom)//"_sd"
+   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(index)=count(int(index))+1
+   index=index+1
+   if (index>istime) then
+      index=1
+   endif
+endif
+
+if (count(index)==0) then
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+      mean3d=0
+      sd3d=0
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+      mean2d=0
+      sd2d=0
+   endif
+else
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif
+
+if (dim.eq.3) then
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+   mean3d= mean3d+dx3
+   sd3d= sd3d+dx3**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+
+else if (dim.eq.2) then
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+   mean2d= mean2d+dx2
+   sd2d= sd2d+dx2**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+
+endif
+
+ierr= NF_CLOSE(nid)
+
+end
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,index,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,size
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,index/)
+   size=(/iip1,jjp1,llm,1/)
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#endif
+
+endif
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yoegwd.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yoegwd.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yoegwd.h	(revision 46)
@@ -0,0 +1,16 @@
+C     -----------------------------------------------------------------
+C*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+C     -----------------------------------------------------------------
+C
+      real GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+
+      integer NKTOPG
+
+      COMMON/YOEGWD/ GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,NKTOPG,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+C
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomaer.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomaer.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomaer.h	(revision 46)
@@ -0,0 +1,55 @@
+!     Radiative characteristics of the aerosols
+! 
+!   Shortwave
+!   ~~~~~~~~~
+! 
+! tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+! in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+
+! For the "naerkind" kind of aerosol radiative properties : 
+! QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+! omegavis   :  sinle scattering albedo     <--- For both solar bands
+! gvis       :  assymetry factor            <--- For both solar bands
+! 
+!   Longwave
+!   ~~~~~~~~
+! 
+! For the "naerkind" kind of aerosol radiative properties : 
+! QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+! omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+! gIR      :  mean assymetry factor         <--- For the nir bandes IR
+! 
+      real tauvis
+      real QVISsQREF(nsun,naerkind,nsizemax)
+      real omegavis(nsun,naerkind,nsizemax)
+      real gvis(nsun,naerkind,nsizemax)
+      real QIRsQREF(nir,naerkind,nsizemax)
+      real omegaIR(nir,naerkind,nsizemax)
+      real gIR(nir,naerkind,nsizemax)
+
+! Actual number of grain size classes in each domain for a
+!   given aerosol:
+
+      INTEGER          :: nsize(naerkind,2)
+
+! Particle size axis (depend on the kind of aerosol and the
+!   radiation domain)
+
+      REAL :: radiustab(naerkind,2,nsizemax)
+
+! Extinction coefficient at reference wavelengths;
+!   These wavelengths are defined in dimradmars.h, and called
+!   longrefvis and longrefir.
+
+      REAL             :: QREFvis(naerkind,nsizemax)
+      REAL             :: QREFir(naerkind,nsizemax)
+      REAL             :: omegaREFvis(naerkind,nsizemax)
+      REAL             :: omegaREFir(naerkind,nsizemax)
+
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+
+      COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,                     &
+     &              QIRsQREF,omegaIR,gIR,                               &
+     &              QREFvis,QREFir,omegaREFvis,omegaREFir,              &
+     &              nsize,radiustab
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomlw.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomlw.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/yomlw.h	(revision 46)
@@ -0,0 +1,21 @@
+C*    Coefficients for the longwave radiation subroutines
+c-----------------------------------------------------------------------
+
+      COMMON/yomlw/at(2,2),bt(2,2)
+     S ,tref,xp(6,nir),tstand
+     S ,ga(npademx,nabsmx),gb(npademx,nabsmx)
+     S ,cst_voigt(2,nabsmx), gcp , nlaylte
+
+      REAL at,bt, tref,xp,tstand,ga,gb, cst_voigt
+      REAL gcp    ! = g/cpp
+
+c     Number of layers on which LTE calculations (in lw and sw) are performed 
+c     (Computed in nlthermeq) :
+      INTEGER nlaylte       
+
+
+      COMMON/ksicom/
+     S xi(ngridmx,nuco2,0:nflev+1,0:nflev+1)
+     S ,xi_ground(ngridmx,nuco2),xi_emis(ngridmx,nuco2,nflev-1)
+
+      real xi, xi_ground, xi_emis
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/zerophys.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/zerophys.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/jb_phymars/home/users/jbmlmd/LMDZ.VERSO/10W12_SP36_splitting/libf/phymars/zerophys.F	(revision 46)
@@ -0,0 +1,11 @@
+      SUBROUTINE zerophys(n,x)
+      IMPLICIT NONE
+      INTEGER n
+      REAL x(n)
+      INTEGER i
+
+      DO i=1,n
+         x(i)=0.
+      ENDDO
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwb.F	(revision 46)
@@ -0,0 +1,140 @@
+      subroutine lwb (kdlon,kflev,tlev,tlay,dt0
+     .               ,bsurf,btop,blay,blev,dblay,dbsublay)
+ 
+c----------------------------------------------------------------------
+c     LWB  computes the planck function and gradient
+c          from a polynomial development of planck function
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nalyer
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+c                                                            outputs:
+c                                                            --------
+      real bsurf (ndlo2,nir)        ! surface spectral planck function
+      real btop (ndlo2,nir)         ! top spectral planck function
+      real blev (ndlo2,nir,kflev+1) ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)   ! layer   spectral planck function
+      real dblay (ndlo2,nir,kflev)  ! layer gradient spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jk, jl, jnu, jk1, jk2
+
+      real ztlay (ndlon)
+      real ztlev (ndlon)
+
+c----------------------------------------------------------------------
+      do jnu=1,nir
+c----------------------------------------------------------------------
+c         1.1   levels and layers from surface to nlaylte
+c               ---------------------------------------
+
+      do jk = 1 , nlaylte
+        do jl = 1 , kdlon
+
+c                                                  level planck function 
+c                                                  ---------------------
+      ztlev(jl)=(tlev(jl,jk)-tstand)/tstand    ! tstand = 200k
+
+      blev(jl,jnu,jk)   = xp(1,jnu)
+     .                    +ztlev(jl)*(xp(2,jnu) 
+     .                    +ztlev(jl)*(xp(3,jnu) 
+     .                    +ztlev(jl)*(xp(4,jnu) 
+     .                    +ztlev(jl)*(xp(5,jnu)
+     .                    +ztlev(jl)*(xp(6,jnu)    )))))
+
+c                                                  layer planck function 
+c                                                  ---------------------
+      ztlay(jl)=(tlay(jl,jk)-tstand)/tstand
+
+      blay(jl,jnu,jk) = xp(1,jnu)
+     .                  +ztlay(jl)*(xp(2,jnu)
+     .                  +ztlay(jl)*(xp(3,jnu)
+     .                  +ztlay(jl)*(xp(4,jnu)
+     .                  +ztlay(jl)*(xp(5,jnu)
+     .                  +ztlay(jl)*(xp(6,jnu)    )))))
+
+c                                               planck function gradient
+c                                               ------------------------
+      dblay(jl,jnu,jk) = xp(2,jnu)
+     .                   +ztlay(jl)*(2*xp(3,jnu)
+     .                   +ztlay(jl)*(3*xp(4,jnu)
+     .                   +ztlay(jl)*(4*xp(5,jnu)
+     .                   +ztlay(jl)*(5*xp(6,jnu)  ))))
+      dblay(jl,jnu,jk) = dblay(jl,jnu,jk)/tstand
+
+        enddo
+      enddo
+     
+c----------------------------------------------------------------------
+c         1.2   top of the atmosphere and surface
+c               --------------------------------
+
+      do jl = 1 , kdlon
+c                                                  top of the atmosphere
+c                                                  ---------------------
+      ztlev(jl) = (tlev(jl,nlaylte+1)-tstand)/tstand
+
+      blev(jl,jnu,nlaylte+1) = xp(1,jnu)
+     .                       +ztlev(jl)*(xp(2,jnu)
+     .                       +ztlev(jl)*(xp(3,jnu)
+     .                       +ztlev(jl)*(xp(4,jnu)
+     .                       +ztlev(jl)*(xp(5,jnu)
+     .                       +ztlev(jl)*(xp(6,jnu)    )))))
+      btop(jl,jnu) = blev(jl,jnu,nlaylte+1)
+
+c                                                                surface
+c                                                                -------
+      ztlay(jl) = (tlev(jl,1)+dt0(jl)-tstand)/tstand
+
+      bsurf(jl,jnu) = xp(1,jnu)
+     .               +ztlay(jl)*(xp(2,jnu)
+     .               +ztlay(jl)*(xp(3,jnu)
+     .               +ztlay(jl)*(xp(4,jnu)
+     .               +ztlay(jl)*(xp(5,jnu)
+     .               +ztlay(jl)*(xp(6,jnu)     )))))
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.3   Gradients in sub-layers
+c               -----------------------
+
+      do jk=1,nlaylte
+        jk2 = 2 * jk
+        jk1 = jk2 - 1 
+          do jl=1,kdlon
+            dbsublay(jl,jnu,jk1)=blay(jl,jnu,jk)-blev(jl,jnu,jk)
+            dbsublay(jl,jnu,jk2)=blev(jl,jnu,jk+1)-blay(jl,jnu,jk)
+          enddo
+      enddo
+
+c----------------------------------------------------------------------
+      enddo           ! (do jnu=1,nir)
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwdiff.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwdiff.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwdiff.F	(revision 46)
@@ -0,0 +1,219 @@
+      subroutine lwdiff (kdlon,kflev
+     .         ,pbsur,pbtop,pdbsl
+     .         ,tautotal,omegtotal,gtotal
+     .         ,pemis,pfluc)
+
+      IMPLICIT NONE
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+C-----------------------------------------------------------------------
+C
+c  ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
+c! 1) Dans la bande a 15 micron (CO2), les poussieres 
+c! n'interviennent que comme un milieu gris non diffusif avec 
+c!                      Q=Qext*(1-Omega)
+c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
+c! pour lesquelles les parametres optiques des poussieres sont
+c! identiques
+c! 2)  le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
+c! les longueurs d'onde inferieures a celles de la bande a 15 microns
+c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
+c! (indices 4...nir) sur chacune de ces  bandes, les poussieres
+c! sont supposees diffusantes grises.
+c!
+C
+C-----------------------------------------------------------------------
+C
+C
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kdlon,kflev
+      REAL PBSUR(NDLO2,nir), PBTOP(NDLO2,nir)
+     S  ,  PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)
+
+      real PFLUC(NDLO2,2,KFLEV+1)
+      real tautotal(ndlon,nflev,nir)
+      real omegtotal(ndlon,nflev,nir), gtotal(ndlon,nflev,nir)
+
+C
+C
+C-------------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      integer jl, jk, ndd, indd, iir, j1
+      integer  j2, j2dd2, j2dd1,j2bot,j2top, j2dd
+      REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1)
+     S  ,  ZDBDT(NDLON,nir,NFLEV)
+     S  ,  ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1)
+     S  ,  ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON)
+     S  ,  ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON)
+     S  ,  ZOMEGADD(NDLON,NFLEV*2),ZGDD(NDLON,NFLEV*2)
+     S  ,  ZTAUDD(NDLON,NFLEV*2)
+     S  ,  ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON)
+     S  ,  ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON)
+     S  ,  ZFAHDD(NDLON,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1)
+     S  ,  ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
+C                  ------------------------------
+C
+ 110  CONTINUE
+C
+
+      do jl = 1 , kdlon
+        do jk = 1 , nlaylte
+          PFLUC(jl,1,jk) = 0.
+          PFLUC(jl,2,jk) = 0.
+        enddo
+      enddo
+
+      DO 112 JK = 1 , nlaylte+1
+        DO 111 JL = 1 , KDLON
+          ZADJD(JL,JK) = 0.
+          ZADJU(JL,JK) = 0.
+          ZDISD(JL,JK) = 0.
+          ZDISU(JL,JK) = 0.
+ 111    CONTINUE
+ 112  CONTINUE
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.      VERTICAL INTEGRATION
+C                  --------------------
+C
+C     ------------------------------------------------------------------
+C
+C
+C  ==================================================================
+C*         2.0     contribution des bandes "hors co2"
+C  ==================================================================
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.1   preparation des Planck a chaque hauteur
+C                  ----------------------------------
+C
+c!
+c! le nombre de couche pour la diffusion sera le nombre de layer * 2
+c! soit NDD=nlaylte*2, donc la taille du vecteur des Planck sera
+c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
+c! par contre nlaylte*2 (voir dans FLUSV.F).
+c!
+      NDD=nlaylte*2
+      DO indd=1,ndd+1
+                                            do jl=1,kdlon
+         ZFAHDD(jl,indd)=0.
+         ZFDHDD(jl,indd)=0.
+         ZBHDD(jl,indd)=0.
+                                            enddo
+      ENDDO
+                                            do jl=1,kdlon
+      ZBSDD(jl)=0.
+                                            enddo
+c!
+c! boucle sur les  bandes hors CO2
+c!
+      DO 10001 iir=3,nir
+c!
+                                            do jl=1,kdlon
+        ZZBHDD(JL,1)=PBTOP(JL,iir)/pi
+                                            enddo
+        DO J1=2,NDD+1
+                                            do jl=1,kdlon
+           ZZBHDD(JL,J1)=
+     &     ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/pi
+                                            enddo
+        ENDDO
+                                            do jl=1,kdlon
+        ZZBSDD(JL)=PBSUR(JL,iir)/pi
+                                            enddo
+
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.2   preparation des coefficients de diffusion
+C                  -----------------------------------------
+C
+c! les omega, g, tau ... boucle de bas en haut
+        DO J2=1,nlaylte-1
+          J2DD2=(nlaylte-J2+1)*2
+          J2DD1=J2DD2-1
+          J2BOT=3*J2-2
+          J2TOP=3*J2+1
+          do jl=1,kdlon
+            ZTAUDD(JL,J2DD1)=tautotal(jl,J2,iir)*0.5
+            ZTAUDD(JL,J2DD2)=ZTAUDD(JL,J2DD1)
+            ZOMEGADD(JL,J2DD1)=omegtotal(jl,J2,iir)
+            ZOMEGADD(JL,J2DD2)=omegtotal(jl,J2,iir)
+            ZGDD(JL,J2DD1)=gtotal(jl,J2,iir)
+            ZGDD(JL,J2DD2)=gtotal(jl,J2,iir)
+          enddo
+        ENDDO
+        J2=nlaylte
+        J2DD2=2
+        J2DD1=1
+        J2BOT=3*J2-2
+                                            do jl=1,kdlon
+        ZTAUDD(JL,J2DD1)= tautotal(jl,J2,iir)*0.5
+        ZTAUDD(JL,J2DD2)= tautotal(jl,J2,iir)*0.5
+        ZOMEGADD(JL,J2DD1)= omegtotal(jl,J2,iir)
+        ZOMEGADD(JL,J2DD2)= omegtotal(jl,J2,iir)
+        ZGDD(JL,J2DD1)= gtotal(jl,J2,iir)
+        ZGDD(JL,J2DD2)= gtotal(jl,J2,iir)
+                                            enddo
+C
+C     ------------------------------------------------------------------
+C
+C*         2.0.3   calcul de la diffusion
+C                  ----------------------
+C
+
+c-----------------------------------------------------------------------
+        CALL flusv(KDLON,0
+     &  ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
+     &  ,ZZBHDD,ZZBSDD
+     &  ,ZZFAHDD,ZZFDHDD)
+c!
+c!  Cumul des flux sur le spectre hors bande du CO2
+c!
+        DO indd=1,ndd+1
+           do jl=1,kdlon
+             ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd)
+             ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd)
+           enddo
+        ENDDO
+10001 CONTINUE
+
+      DO J2=1,nlaylte+1
+        J2DD=(nlaylte-J2+1)*2+1
+        do jl=1,kdlon
+          PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD)
+          PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD)
+        enddo
+      ENDDO
+
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwflux.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwflux.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwflux.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwflux.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwi.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwi.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwmain.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwmain.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwtt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwtt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwtt.F	(revision 46)
@@ -0,0 +1,65 @@
+      subroutine lwtt (kdlon,u,up,nu,tr)
+
+c----------------------------------------------------------------------
+c     LWTT   computes the longwave transmission functions
+c            for all the absorbers in all spectral intervals
+c            using pade approximants and horner's algorithm
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon            ! part of ngrid
+      integer nu               ! 
+
+      real    u (ndlo2,nu)     ! absorber amounts 
+      real    up (ndlo2,nu)    ! idem scaled by the pressure
+
+c                                                            outputs:
+c                                                            --------
+      real    tr (ndlo2,nu)    ! transmission functions
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl
+
+      real xn (ndlon)
+      real xd (ndlon)
+      real ueq (ndlon)
+
+c----------------------------------------------------------------------
+c   Transmission by the CO2 15 microns band:
+c   ----------------------------------------
+
+      do  ja=1,nu
+	    do jl=1,kdlon
+c                              equivalent absorber amount (Doppler effect)
+c                             --------------------------------------------
+	      ueq(jl) = sqrt(up(jl,ja))
+     .              +cst_voigt(1,ja)*u(jl,ja)**cst_voigt(2,ja)
+
+c                                                      Horner's algorithm
+c                                                      ------------------
+            xn(jl) = ga(1,ja) + 
+     .      ueq(jl)*(ga(2,ja) + ueq(jl) * ga(3,ja) )
+            xd(jl) = gb(1,ja) + ueq(jl)*(gb(2,ja) + 
+     .      ueq(jl) * ( gb(3,ja) + ueq(jl)  ))
+            tr(jl,ja) = xn(jl) / xd(jl)
+
+	    enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwu.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwu.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwu.F	(revision 46)
@@ -0,0 +1,209 @@
+      subroutine lwu (kdlon,kflev
+     &                ,dp,plev,tlay,aerosol 
+     &                ,QIRsQREF3d,omegaIR3d,gIR3d
+     &                ,aer_t,co2_u,co2_up
+     &                ,tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c     LWU   computes  - co2: longwave effective absorber amounts including 
+c                      pressure and temperature effects 
+c                     - aerosols: amounts for every band
+c                                transmission for bandes 1 and 2 of co2
+c----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+c! modif diffusion
+c! on ne change rien a la bande CO2 : les quantites d'absorbant CO2
+c! sont multipliees par 1.66
+c! pview= 1/cos(teta0)=1.66
+c
+c Modif J.-B. Madeleine: Computing optical properties of dust and
+c   water-ice crystals in each gridbox. Optical parameters of
+c   water-ice clouds are convolved to crystal sizes predicted by
+c   the microphysical scheme.
+c-----------------------------------------------------------------------
+ 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------                                    
+c                                                            inputs:
+c                                                            -------
+      integer kdlon        ! part of ngrid
+      integer kflev        ! part of nalyer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol (ndlo2,kflev,naerkind) ! aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+      REAL QIRsQREF3d(ndlo2,kflev,nir,naerkind)  ! 3d ext. coef.
+      REAL omegaIR3d(ndlo2,kflev,nir,naerkind)   ! 3d ssa
+      REAL gIR3d(ndlo2,kflev,nir,naerkind)       ! 3d assym. param.
+
+c                                                            outputs:
+c                                                            --------
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer) 
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols properties)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer jl,jk,jkl,ja,n
+ 
+      real aer_u (ndlon,nir,nflev+1)     ! absorber amounts (aer) extinction
+      real co2c           ! co2 concentration (pa/pa)
+      real pview          ! cosecant of viewing angle
+      real pref           ! reference pressure (1013 mb = 101325 Pa)
+      real tx,tx2
+      real phi (ndlon,nuco2)
+      real psi (ndlon,nuco2)
+      real plev2 (ndlon,nflev+1)
+      real zzz
+
+      real ray,coefsize,coefsizew,coefsizeg 
+
+c************************************************************************
+c----------------------------------------------------------------------
+c         0.3  Initialisation  
+c               -------------
+
+      pview = 1.66
+      co2c = 0.95           
+      pref = 101325.
+
+      do jk=1,nlaylte+1
+        do jl=1,kdlon
+          plev2(jl,jk)=plev(jl,jk)*plev(jl,jk)
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c  Computing TOTAL single scattering parameters by adding properties of
+c  all the NAERKIND kind of aerosols in each IR band
+
+      call zerophys(ndlon*kflev*nir,tautotal)
+      call zerophys(ndlon*kflev*nir,omegtotal)
+      call zerophys(ndlon*kflev*nir,gtotal)
+
+      do n=1,naerkind
+        do ja=1,nir
+          do jk=1,nlaylte
+            do jl = 1,kdlon
+              tautotal(jl,jk,ja)=tautotal(jl,jk,ja) +
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)
+              omegtotal(jl,jk,ja) =  omegtotal(jl,jk,ja) + 
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+     &           omegaIR3d(jl,jk,ja,n)
+              gtotal(jl,jk,ja) =  gtotal(jl,jk,ja) + 
+     &           QIRsQREF3d(jl,jk,ja,n)*aerosol(jl,jk,n)*
+     &           omegaIR3d(jl,jk,ja,n)*gIR3d(jl,jk,ja,n)
+            enddo
+          enddo
+        enddo
+      enddo
+      do ja=1,nir
+        do jk=1,nlaylte
+          do jl = 1,kdlon
+             gtotal(jl,jk,ja)=gtotal(jl,jk,ja)/omegtotal(jl,jk,ja)
+             omegtotal(jl,jk,ja)=omegtotal(jl,jk,ja)/tautotal(jl,jk,ja)
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.0   cumulative (aerosol) amounts (for every band)
+c               ----------------------------
+
+      jk=nlaylte+1
+      do ja=1,nir
+        do jl = 1 , kdlon
+          aer_u(jl,ja,jk)=0.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+        jkl=nlaylte+1-jk
+        do ja=1,nir
+          do jl=1,kdlon
+             aer_u(jl,ja,jkl)=aer_u(jl,ja,jkl+1)+ tautotal(jl,jkl,ja)
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+c         1.0   bands 1 and 2 of co2
+c               --------------------
+
+      jk=nlaylte+1
+      do ja=1,nuco2
+        do jl = 1 , kdlon
+          co2_u(jl,ja,jk)=0.
+          co2_up(jl,ja,jk)=0.
+          aer_t(jl,ja,jk)=1.
+        enddo
+      enddo
+
+      do jk=1,nlaylte
+                       jkl=nlaylte+1-jk
+        do ja=1,nuco2
+          do jl=1,kdlon
+
+c                 introduces temperature effects on absorber(co2) amounts
+c                 -------------------------------------------------------
+            tx = sign(min(abs(tlay(jl,jkl)-tref),70.)
+     .         ,tlay(jl,jkl)-tref)
+            tx2=tx*tx
+            phi(jl,ja)=at(1,ja)*tx+bt(1,ja)*tx2
+            psi(jl,ja)=at(2,ja)*tx+bt(2,ja)*tx2
+            phi(jl,ja)=exp(phi(jl,ja)/cst_voigt(2,ja))
+            psi(jl,ja)=exp(2.*psi(jl,ja))
+
+c                                        cumulative absorber(co2) amounts
+c                                        --------------------------------
+            co2_u(jl,ja,jkl)=co2_u(jl,ja,jkl+1)
+     .     +         pview/(10*g)*phi(jl,ja)*dp(jl,jkl)*co2c
+
+            co2_up(jl,ja,jkl)=co2_up(jl,ja,jkl+1)
+     .     +         pview/(10*g*2*pref)*psi(jl,ja)
+     .     *        (plev2(jl,jkl)-plev2(jl,jkl+1))*co2c
+
+
+c                                                  (aerosol) transmission
+c                                                  ----------------------
+c   on calcule directement les transmissions pour les aerosols.
+c   on multiplie le Qext  par 1-omega dans la bande du CO2.
+c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr
+
+           zzz=pview*(1.-omegtotal(jl,jkl,ja))
+           aer_t(jl,ja,jkl)=exp(-zzz*aer_u(jl,ja,jkl))
+          
+          enddo
+        enddo
+      enddo                 
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxb.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwxb.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxd.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwxd.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/lwxn.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/lwxn.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_callkeys.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_callkeys.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_callkeys.h	(revision 46)
@@ -0,0 +1,63 @@
+!
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+      COMMON/callkeys/callrad,calldifv,calladj,callcond,callsoil,       &
+     &   season,diurnal,iradia,lwrite,calllott                          &
+     &   ,iaervar,iddist,topdustref,callstats,calleofdump               &
+     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+     &        calleuv,callmolvis,callmoldiff,thermochem                 &
+     &   , solarcondate, thermoswater                                   &
+     &   , semi                                                         &
+     &   , callemis                                                     &
+     &   , callg2d                                                      &
+     &   , linear                                                       &
+     &   , ilwd                                                         &
+     &   , ilwb                                                         &
+     &   , ilwn                                                         &
+     &   , ncouche                                                      &
+     &   , alphan                                                       &
+     &   , rayleigh                                                     &
+     &   , tracer                                                       &
+     &   , dustbin,active,doubleq,lifting,callddevil,scavenging         &
+     &   , sedimentation,activice,water,caps                            &
+     &   , photochem,nqchem_min                                         
+
+      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,lifting,callddevil,scavenging
+      logical sedimentation,activice,water,caps
+      !!! plus besoin de iceparty ??
+      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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_dimphys.h_ref
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_dimphys.h_ref	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_dimphys.h_ref	(revision 46)
@@ -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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_inifis.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_inifis.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_inifis.F	(revision 46)
@@ -0,0 +1,815 @@
+      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 "slope.h"
+#include "comsoil.h"     !!**WRF -- needed to fill volcapa
+      INTEGER ngrid,nlayer,nq
+
+      REAL prad,pg,pr,pcpp,pdaysec
+      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 prad,pg,pr,pcpp,pdaysec,ptimestep
+! 
+!      INTEGER ngrid,nlayer
+      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
+      integer wday_ini
+      REAL wdt
+      INTEGER ig,ierr
+
+      INTEGER wecri_phys, wappel_phys
+ 
+      EXTERNAL iniorbit,orbite
+      EXTERNAL SSUM
+      REAL SSUM
+ 
+      CHARACTER ch1*12
+      CHARACTER ch80*80
+
+      logical chem, h2o
+
+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 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: Parametres pour la physique (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+
+         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
+
+! Test of incompatibility:
+! if doubleq is used, then dustbin should be 1
+
+         if (doubleq.and.(dustbin.ne.1)) then
+           print*,'if doubleq is used, then dustbin should be 1'
+           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=10*int(daysec/dtphys) 
+      ilwn=2               
+      linear=.true.        
+      ncouche=3
+      alphan=0.4
+      ilwb=2
+      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:
+!     -------------------------------
+
+      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:'
+
+       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.ne.4) then
+           print*,'nqmx should be 4 with these options.'
+		   print*,'(or check callphys.def)'
+           stop
+         endif
+       endif
+
+       if ((doubleq).and..not.(h2o)) then
+         print*,' 2 dust tracers (doubleq)'
+         if (nqmx.ne.2) then
+           print*,'nqmx should be 2 with these options...'
+		   print*,'(or check callphys.def)'
+           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
+
+       if (.not.(doubleq).and..not.(h2o)) then
+         if (dustbin.gt.0) then
+           print*,dustbin,' dust bins'
+           if (nqmx.ne.dustbin) then
+             print*,'nqmx should be ',dustbin,
+     $              ' with these options...'
+             print*,'(or check callphys.def)'
+             stop
+           endif
+         else
+           print*,'dustbin=',dustbin,
+     $            ': tracer should be F with these options...'
+     $           ,'UNLESS you just want to move tracers around '
+         endif
+       endif
+
+      endif ! of if (tracer)
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_physiq.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_physiq.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_physiq.F	(revision 46)
@@ -0,0 +1,1808 @@
+      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)        /
+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 "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)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+      REAL rnuclei(ngridmx,nlayermx)   ! Prescribed dust radius in each
+                                     !   layer (m)
+
+      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 -----------------
+
+
+      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, PARAMETER :: taufirstcall(ngridmx,naerkind) = 0.2
+                                     ! Estimated column dust optical depth at
+                                     ! firstcall
+      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 reff(ngridmx,nlayermx) ! effective dust radius (used if doubleq=T)
+      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 opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! 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*,'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         
+                   
+      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          Estimate the ice particle size distribution at firstcall:
+c          --------------------------------------------------------
+
+c
+c **WRF: a verifier
+c
+           IF (firstcall.AND.activice) THEN
+             CALL watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,taufirstcall,
+     &                rnuclei,rice,nuice)
+           ENDIF
+
+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,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 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 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,
+     &                rnuclei,rice,nuice)
+c          if (activice) then
+c Temperature variation due to latent heat release
+c          DO l=1,nlayer
+c            DO ig=1,ngrid
+c              pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+c            ENDDO
+c          ENDDO
+c          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)
+           call zerophys(ngrid*nq, zdqssed)
+
+           if(doubleq) then
+            call callsedim2q(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           else
+c
+c **WRF: new arguments rnuclei, rice, need checks
+c
+            call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rnuclei, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           end if
+
+           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)=0.45                                     
+              albedo(ig,2)=0.45                                     
+           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,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
+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)-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))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+             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,' local tau =',tau(1,1)
+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')
+         CALL writeg1d(ngrid,1,ps,'ps','Pa')
+         
+         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')
+
+         if(tracer) then
+c           CALL writeg1d(ngrid,1,tau,'tau','SI')
+            do iq=1,nq
+              CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+            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/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_testphys1d.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_testphys1d.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/meso_testphys1d.F	(revision 46)
@@ -0,0 +1,602 @@
+
+      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 "aerdust.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
+
+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='run.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)
+      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    ---------------------------
+
+      DO iq=1,nqmx
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+
+      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.
+      
+      DO iq=1,nqmx-1
+        qsurf(iq) = 0.
+      ENDDO
+
+
+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: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mkstat.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mkstat.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mkstat.F90	(revision 46)
@@ -0,0 +1,164 @@
+subroutine mkstats(ierr)
+
+ 
+!
+!  This program writes a stats.nc file from sums and sums of squares
+!  to means and standard deviations and also writes netcdf style
+!  file so that the data can be viewed easily.  The data file is
+!  overwritten in place.  
+!  SRL  21 May 1996
+!  Yann W. july 2003
+
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
+integer, dimension(4) :: id,varid,start,size
+integer, dimension(5) :: dimids
+character (len=50) :: name,nameout,units,title
+real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
+real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
+real, dimension(istime) :: time
+real, dimension(jjp1) :: lat
+real, dimension(iip1) :: lon
+real, dimension(llm) :: alt
+logical :: lcopy=.true.
+!integer :: latid,lonid,altid,timeid
+integer :: meanid,sdid
+!integer, dimension(4) :: dimout
+
+! Incrementation of count for the last step, which is not done in wstats
+count(istime)=count(istime)+1
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+! We catch the id of dimensions of the stats file
+
+ierr= NF_INQ_DIMID(nid,"latitude",id(1))
+ierr= NF_INQ_DIMID(nid,"longitude",id(2))
+ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+ierr= NF_INQ_VARID(nid,"latitude",varid(1))
+ierr= NF_INQ_VARID(nid,"longitude",varid(2))
+ierr= NF_INQ_VARID(nid,"altitude",varid(3))
+ierr= NF_INQ_VARID(nid,"Time",varid(4))
+
+! Time initialisation
+
+do i=1,istime
+   time(i)=i*24./istime
+#ifdef NC_DOUBLE
+   ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i))
+#else
+   ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i))
+#endif
+enddo
+
+! We catche the values of the variables
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,varid(1),lat)
+         ierr = NF_GET_VAR_REAL(nid,varid(2),lon)
+         ierr = NF_GET_VAR_REAL(nid,varid(3),alt)
+#endif
+
+! We catch the number of variables in the stats file
+ierr = NF_INQ_NVARS(nid,nbvar)
+
+! to catche the "real" number of variables (without the "additionnal variables")
+nbvar=(nbvar-4)/2 
+
+do i=1,nbvar
+   varid=(i-1)*2+5
+
+   ! What's the variable's name?
+   ierr=NF_INQ_VARNAME(nid,varid,name)
+   write(*,*) "OK variable ",name
+   ! Its units?
+   units=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
+   ! Its title?
+   title=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
+   ! Its number of dimensions?   
+   ierr=NF_INQ_VARNDIMS(nid,varid,ndims)
+   ! Its values?
+
+   if(ndims==4) then ! lat, lon, alt & time
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=altid
+!      dimout(4)=timeid
+
+      size=(/iip1,jjp1,llm,1/)
+      do lt=1,istime
+         start=(/1,1,1,lt/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d)
+#endif
+         ! Calculation of these variables
+         mean3d=sum3d/count(lt)
+         sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d)
+#endif
+      enddo
+
+    else if (ndims.eq.3) then
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=timeid
+
+      size=(/iip1,jjp1,1,0/)
+      do lt=1,istime
+         start=(/1,1,lt,0/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d)
+#endif
+         ! Calculation of these variables
+         mean2d=sum2d/count(lt)
+         sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d)
+#endif
+      enddo
+
+    endif 
+enddo
+
+ierr= NF_CLOSE(nid)
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mucorr.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mucorr.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mucorr.F	(revision 46)
@@ -0,0 +1,102 @@
+      SUBROUTINE mucorr(npts,pdeclin, plat, pmu, pfract,phaut,prad)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         pdeclin          solar declinaison
+c         plat(npts)        latitude
+c         phaut            hauteur typique de l'atmosphere
+c         prad             rayon planetaire
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL phaut,prad,pdeclin
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b, tp
+      REAL alph
+
+c-----------------------------------------------------------------------
+
+      pi = 4. * atan(1.0)
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+   
+         IF(t.eq.0.) then
+            tp=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + pi
+            ELSE
+               tp = atan(t)
+            ENDIF
+         ENDIF
+         t = tp
+   
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+   20 CONTINUE
+
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+      alph=phaut/prad
+      DO 30 j=1,npts
+c !!!!!!
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+c    $          (sqrt(alph*alph*pmu(j)*pmu(j)+2.*alph+1.)-alph*pmu(j))
+30    CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mufract.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mufract.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/mufract.F	(revision 46)
@@ -0,0 +1,92 @@
+      SUBROUTINE mufract(jjm,pdecli, plat, pmu, pfract)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         jjm              number of points
+c         pdecli           solar declinaison
+c         plat(jjm)        latitude
+c
+c      Output :
+c      --------
+c         pmu(jjm)          equivalent cosinus of the solar angle
+c         pfract(jjm)       fractionnal day
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+c
+c     Arguments :
+c     -----------
+
+      INTEGER jjm
+      REAL plat(jjm),pmu(jjm), pfract(jjm)
+      REAL pdecli
+c
+c     Local variables :
+c     -----------------
+
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b
+c
+c=======================================================================
+c
+      pi = 4. * atan(1.0)
+      z = pdecli
+      cz = cos (z*pi/180.)
+      sz = sin (z*pi/180.)
+c
+      DO 20 j = 1, jjm
+c
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+         IF(t.eq.0.) THEN
+            t=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) THEN
+               t = -atan (-t) + pi
+            ELSE
+               t = atan(t)
+            ENDIF
+         ENDIF
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) THEN
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+c
+   20 CONTINUE
+c
+      RETURN
+      END
+c
+c* end of mufract
+c=======================================================================
+c
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/multipl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/multipl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/multipl.F	(revision 46)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newcondens.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newcondens.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newcondens.F	(revision 46)
@@ -0,0 +1,878 @@
+      SUBROUTINE 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
+c 
+cc           Tendencies on T, U, V, Q 
+cc           """"""""""""""""""""""""
+c            DO l=1,nlayer
+c 
+cc             Tendencies on T
+c                zdtsig(ig,l) = (1/masse(l)) *
+c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+c                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+c
+cc             Tendencies on U
+c                pduc(ig,l)   = (1/masse(l)) *
+c     &        ( zmflux(l)*(zum(l) - zu(l))
+c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+c
+c
+cc             Tendencies on V
+c                pdvc(ig,l)   = (1/masse(l)) *
+c     &        ( zmflux(l)*(zvm(l) - zv(l))
+c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+c
+c            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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newsedim.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newsedim.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/newsedim.F	(revision 46)
@@ -0,0 +1,185 @@
+      SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+     &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Compute sedimentation of 1 tracer 
+c      of radius rd (m) and density rho (kg.m-3) 
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,naersize
+      REAL ptimestep            ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pt(ngrid,nlay)    ! temperature au centre des couches (K)
+      real masse (ngrid,nlay) ! masse d'une couche (kg)
+      real epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+      real rd(naersize)             ! particle radius (m)
+      real rho             ! particle density (kg.m-3)
+
+
+c    Traceurs :
+      real pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+      real wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, k, i
+      REAL rfall
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      real traversee (ngridmx,nlayermx)
+      real vstokes(ngridmx,nlayermx)
+      real w(ngridmx,nlayermx)
+      real ptop, dztop, Ep, Stra
+
+      DATA firstcall/.true./
+
+c    Physical constant
+c    ~~~~~~~~~~~~~~~~~
+      REAL visc, molrad
+c     Gas molecular viscosity (N.s.m-2)
+      data visc/1.e-5/       ! CO2
+c     Effective gas molecular radius (m)
+      data molrad/2.2e-10/   ! CO2
+
+c     local and saved variable
+      real a,b
+      save a,b
+
+
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans newsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+
+
+c       Preliminary calculations for sedimenation velocity :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       - Constant to compute stokes speed simple formulae
+c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+         b = 2./9. * g / visc
+
+c       - Constant  to compute gas mean free path
+c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+         a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+
+c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+c   (correction = 0.85 for irregular particles, 0.5 for disk shaped particles)
+c        a = a    * 0.85
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c     Sedimentation velocity (m/s)
+c     ~~~~~~~~~~~~~~~~~~~~~~
+c     (stokes law corrected for low pressure by the Cunningham
+c     slip-flow correction  according to Rossow (Icarus 36, 1-50, 1978)
+
+        do  l=1,nlay
+          do ig=1, ngrid
+            if (naersize.eq.1) then 
+              rfall=rd(1)
+            else
+              i=ngrid*(l-1)+ig
+              rfall=rd(i)
+            endif  
+            vstokes(ig,l) = b * rho * rfall**2 *
+     &      (1 + 1.333* ( a*pt(ig,l)/pplev(ig,l) )/rfall)
+
+c           Layer crossing time (s) :
+            traversee(ig,l)= epaisseur(ig,l)/vstokes(ig,l)
+          end do
+        end do
+
+
+c     Calcul de la masse d'atmosphere correspondant a q transferee
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     (e.g. on recherche le niveau  en dessous de laquelle le traceur
+c      va traverser le niveau intercouche l : "dztop" est sa hauteur
+c      au dessus de l (m), "ptop" est sa pression (Pa))
+
+      do  l=1,nlay
+        do ig=1, ngrid
+             
+             dztop = vstokes(ig,l)*  ptimestep 
+             Ep=0
+             k=0
+
+c **************************************************************
+c            Simple Method
+             w(ig,l) =
+     &       (1- exp(-dztop*g/(r*pt(ig,l))))*pplev(ig,l) / g
+cc           write(*,*) 'OK simple method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK simple method dztop =', dztop
+c **************************************************************
+cccc         Complex method :
+            if (dztop.gt.epaisseur(ig,l)) then
+cccc            Cas ou on "epuise" la couche l : On calcule le flux
+cccc            Venant de dessus en tenant compte de la variation de Vstokes
+
+               Ep= epaisseur(ig,l)
+               Stra= traversee(ig,l)
+               do while(dztop.gt.Ep.and.l+k+1.le.nlay)
+                 k=k+1
+                 dztop= Ep + vstokes(ig,l+k)*(ptimestep -Stra)
+                 Ep = Ep + epaisseur(ig,l+k)
+                 Stra = Stra + traversee(ig,l+k)
+               enddo 
+               Ep = Ep - epaisseur(ig,l+k)
+             end if
+             ptop=pplev(ig,l+k)*exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+             w(ig,l) = (pplev(ig,l) -Ptop)/g
+c
+cc           write(*,*) 'OK new    method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK new    method dztop =', dztop
+cc       if(l.eq.7)write(*,*)'l=7,k,pplev,Ptop',pplev(ig,l),Ptop
+cc       if(l.eq.7)write(*,*)'l=7,dztop,Ep',dztop,Ep
+cc            if(l.eq.6)write(*,*)'l=6,k, w',k, w(1,l)
+cc            if(l.eq.7)write(*,*)'l=7,k, w',k, w(1,l)
+cc            if(l.eq.8)write(*,*)'l=8,k, w',k, w(1,l)
+c **************************************************************
+        end do
+      end do
+
+      call vlz_fi(ngrid,pqi,2.,masse,w,wq)
+c         write(*,*) ' newsed: wq(6), wq(7), q(6)',
+c    &                wq(1,6),wq(1,7),pqi(1,6)
+
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nirco2abs.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nirco2abs.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nirco2abs.F	(revision 46)
@@ -0,0 +1,144 @@
+      SUBROUTINE nirco2abs(ngrid,nlayer,pplay,dist_sol,
+     $     mu0,fract,declin,pdtnirco2)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing heating rate due to
+c   absorption by CO2 in the near-infrared
+c   This version includes NLTE effects
+c
+c   (Scheme to be described in Forget et al., JGR, 2003)
+c   (old Scheme described in Forget et al., JGR, 1999)
+c
+c   This version updated with a new functional fit,
+c   see NLTE correction-factor of Lopez-Valverde et al (1998)
+c   Stephen Lewis 2000
+c  
+c   08/2002 : correction for bug when running with diurnal=F
+c
+c   author:  Frederic Hourdin 1996 
+c   ------
+c            Francois Forget 1999 
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   dist_sol              sun-Mars distance (AU)
+c   mu0(ngridmx)          
+c   fract(ngridmx)        day fraction of the time interval
+c   declin                latitude of subslar point
+c
+c   output:
+c   -------
+c
+c   pdtnirco2(ngrid,nlayer)      Heating rate (K/s)
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer
+
+      REAL pplay(ngrid,nlayer)
+      REAL dist_sol,mu0(ngridmx),fract(ngridmx),declin
+
+      REAL pdtnirco2(ngrid,nlayer)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig, n, nstep
+      REAL co2heat0, zmu(ngridmx)
+
+c     special diurnal=F 
+      real mu0_int(ngridmx),fract_int(ngridmx),zday_int
+      real ztim1,ztim2,ztim3,step
+
+c
+c   local saved variables
+c   ---------------------
+
+c     p0noonlte is a pressure below which non LTE effects are significant.
+c     REAL p0nonlte
+c     DATA p0nonlte/7.5e-3/
+c     SAVE p0nonlte
+
+c     parameters for CO2 heating fit
+      real n_a, n_p0, n_b
+      parameter (n_a=1.1956475)
+      parameter (n_b=1.9628251)
+      parameter (n_p0=0.0015888279)
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+c     co2heat is the heating by CO2 at 700Pa for a zero zenithal angle.
+      co2heat0=n_a*(1.52/dist_sol)**2/daysec
+
+c     Simple calcul for a given sun incident angle (if diurnal=T)
+c     --------------------------------------------
+
+      IF (diurnal) THEN  
+         do ig=1,ngrid
+            zmu(ig)=sqrt(1224.*mu0(ig)*mu0(ig)+1.)/35.
+         enddo
+         do l=1,nlayer
+           do ig=1,ngrid
+             if(fract(ig).gt.0.) pdtnirco2(ig,l)=
+     &             co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &             /(1.+n_p0/pplay(ig,l))**n_b
+
+c           OLD SCHEME (forget et al. 1999)
+c    s           co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+c    s          / (1+p0nonlte/pplay(ig,l))
+           enddo
+         enddo
+
+c     Averaging over diurnal cycle (if diurnal=F)
+c     -------------------------------------------
+c     NIR CO2 abs is slightly non linear. To remove the diurnal
+c     cycle, it is better to average the heating rate over 1 day rather
+c     than using the mean mu0 computed by mucorr in physiq.F (FF, 1998)
+
+      ELSE      ! if (.not.diurnal) then
+
+         nstep = 20   ! number of integration step /sol
+         do n=1,nstep
+            zday_int = (n-1)/float(nstep)
+            ztim2=COS(declin)*COS(2.*pi*(zday_int-.5))
+            ztim3=-COS(declin)*SIN(2.*pi*(zday_int-.5))
+            CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s             ztim1,ztim2,ztim3,
+     s             mu0_int,fract_int)
+            do ig=1,ngrid
+               zmu(ig)=sqrt(1224.*mu0_int(ig)*mu0_int(ig)+1.)/35.
+            enddo
+            do l=1,nlayer
+               do ig=1,ngrid
+                  if(fract_int(ig).gt.0.) pdtnirco2(ig,l)=
+     &                 pdtnirco2(ig,l) + (1/float(nstep))*
+     &                 co2heat0*sqrt((700.*zmu(ig))/pplay(ig,l))
+     &                 /(1.+n_p0/pplay(ig,l))**n_b
+               enddo
+            enddo
+         end do
+      END IF
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltecool.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltecool.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltecool.F	(revision 46)
@@ -0,0 +1,306 @@
+c**************************************************************************
+c
+      subroutine nltecool(ngrid,nlayer,pplay,pt,dtnlte)
+c
+c This code was designed as a delivery for the "Martian Environment Models" 
+c project ( ESA contract 11369/95/nl/jg CCN2 )
+c Computes non-LTE heating rates from CO2 emission at 15 um
+c in the Martian upper atmosphere.
+c Uses a simplified model consisting of two excited levels with two
+c emission bands, one of them stronger than the other, which correspond
+c to the behaviours of the 626 fundamental band and the isotopic fund.bands.
+c It uses a cool-to-space approximation with tabulated escape functions.
+c These escape functions have been precomputed for the strong and weak bands,
+c and are given as a function of pressure in separate files.
+c The output values are the heating rates (actually, cooling, since they
+c are always negative) for the two bands, i.e., the total cooling is the
+c sum of them.
+c Miguel A. Lopez Valverde
+c Instituto de Astrofisica de Andalucia (CSIC), Granada, Spain
+c
+c Version 1b.  See description above.  22-March-2000.
+c Adapted as a subroutine for use in GCM -- PLR/SRL 6/2000
+c Version 1c.  Inclusion of VMR in the tabulation of escape functions. 
+c              Table contains now only 1 input file -- Miguel 11/Jul/2000
+c Version 1d  data contained in original input file "nlte_escape.dat"
+c now stored in include file "nltedata.h" Y.Wanherdrick 09/2000
+c     
+c***************************************************************************
+
+      implicit none
+
+#include "nltedata.h" ! (Equivalent to the reading of the "nlte_escape.dat" file)
+ 
+c Input and output variables
+c
+      integer     ngrid                           ! no. of horiz. gridpoints
+      integer     nlayer                          ! no. of atmospheric layers
+      real        pplay(ngrid,nlayer)             ! input pressure grid
+      real        pt(ngrid,nlayer)                ! input temperatures
+      real        dtnlte(ngrid,nlayer)            ! output temp. tendencies
+
+c
+c Standard atmosphere variables
+c
+      real        nt                              ! number density [cm-3]
+      real        co2(nlayer)                     !  "   of CO2
+      real        o3p(nlayer)                     !  "   of atomic oxygen
+      real        n2co(nlayer)                    !  "  of N2 + CO
+      real        pyy(nlayer)                     ! auxiliary pressure grid
+
+c
+c Vectors and indexes for the tabulation of escape functions and VMR
+c
+c                 np                              ! # data points in tabulation
+c                 pnb(np)                         ! Pressure in tabulation
+c                 ef1(np)                         ! Esc.funct.#1, tabulated
+c                 ef2(np)                         ! Esc.funct.#2, tabulated
+c                 co2vmr(np)                      ! CO2 VMR tabulated
+c                 o3pvmr(np)                      ! CO2 VMR tabulated
+c                 n2covmr(np)                     ! N2+CO VMR tabulated
+      real        escf1(nlayer)                   ! Esc.funct.#1, interpolated
+      real        escf2(nlayer)                   ! Esc.funct.#2, interpolated
+
+
+c
+c Local Constants
+c
+      real       nu1, nu2                         ! freq. of energy levels
+      real       imr1, imr2                       ! isotopic abundances
+      real       hplanck, gamma, vlight           ! physical constants
+      real       ee
+      real       rfvt                             ! collisional rate
+      real       rfvto3p                          !     "
+      real       rfvv                             !     "
+
+c
+c Local variables for the main loop
+c
+      real       n1, n2, co2t                     ! ground populations
+      real       l1, p1, p12                      ! prod & losses
+      real       l2, p2, p21
+      real       tt                               ! dummy variable
+      real       c1, c2                           ! molecular constants
+      real       ae1, ae2                         ! einstein spontaneous emission
+      real       a1, a2, a12, a21
+      real       pl1, pl2
+      real       el1, el2
+      real       hr1, hr2                         ! heating rate due to each band
+      real       hr(nlayer)                       ! total heating rate
+
+c
+c Indexes
+c
+      integer    i
+      integer    j,ii
+
+c
+c Rate coefficients
+c
+      real       k19xca, k19xcb
+      real       k19cap1, k19cap2
+      real       k19cbp1, k19cbp2
+      real       d19c, d19cp1, d19cp2
+      real       k20xc, k20cp1, k20cp2
+      real       k21xc, k21cp2
+
+      logical    firstcall
+      data       firstcall/.true./
+      save       firstcall,ef1,ef2,co2vmr,n2covmr,o3pvmr,pnb
+
+c
+c Data
+c
+      data       nu1, nu2, hplanck, gamma, vlight, ee/
+     1     667.38, 662.3734, 6.6261e-27, 1.191e-5, 3.e10, 1.438769/
+
+c*************************************************************************
+c       PROGRAM  STARTS
+c*************************************************************************
+
+      imr1 = 0.987
+      imr2 = 0.00408 + 0.0112
+      rfvt = 0.1
+      rfvto3p = 1.0
+      rfvv = 0.1
+
+      if(firstcall) then
+
+         do i=1,np
+            pnb(i)=1.0e-4*exp(pnb(i)) ! p into Pa
+         end do
+
+         firstcall = .false.
+
+      endif
+
+c
+c MAIN LOOP, for each gridpoint and altitude:
+c
+      do j=1,ngrid  ! loop over grid points
+c
+c set up local pressure grid
+c
+         do ii=1,nlayer
+            pyy(ii)=pplay(j,ii)
+         enddo
+!
+! Interpolate escape functions and VMR to the desired grid
+!
+         call interp1(escf2,pyy,nlayer,ef2,pnb,np)
+         call interp1(escf1,pyy,nlayer,ef1,pnb,np)
+         call interp3(co2,o3p,n2co,pyy,nlayer,
+     &        co2vmr,o3pvmr,n2covmr,pnb,np)
+        
+         do i=1,nlayer  ! loop over layers
+C
+C test if p lies outside range (p > 3.5 Pa)
+C changed to 1 Pa since transition will always be higher than this
+C
+            if(pyy(i) .gt. 1.0 .or. pyy(i) .lt. 4.0e-6) then 
+               hr(i)=0.0
+               dtnlte(j,i)=0.0
+            else
+c
+c           if(pt(j,i).lt.1.0)print*,pt(j,i)
+               nt = pyy(i)/(1.381e-17*pt(j,i)) ! nt in cm-3
+               co2(i)=co2(i)*nt                ! CO2 density in cm-3
+               o3p(i)=o3p(i)*nt                ! O3p density in cm-3
+               n2co(i)=n2co(i)*nt              ! N2+CO in cm-3
+c molecular populations
+               n1 = co2(i) * imr1
+               n2 = co2(i) * imr2
+               co2t = n1 + n2
+
+c intermediate collisional rates
+               tt = pt(j,i)*pt(j,i)
+
+               if (pt(j,i).le.175.0) then
+                  k19xca = 3.3e-15
+                  k19xcb = 7.6e-16
+               else
+                  k19xca = 4.2e-12 * exp( -2988.0/pt(j,i) + 303930.0/tt)
+                  k19xcb = 2.1e-12 * exp( -2659.0/pt(j,i) + 223052.0/tt)
+               endif
+               k19xca = k19xca * rfvt
+               k19xcb = k19xcb * rfvt
+               k19cap1 = k19xca * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cap2 = k19xca * 2.0 * exp( -ee*nu2/pt(j,i) )
+               k19cbp1 = k19xcb * 2.0 * exp( -ee*nu1/pt(j,i) )
+               k19cbp2 = k19xcb * 2.0 * exp( -ee*nu2/pt(j,i) )
+               d19c = k19xca*co2t + k19xcb*n2co(i)
+               d19cp1 = k19cap1*co2t + k19cbp1*n2co(i)
+               d19cp2 = k19cap2*co2t + k19cbp2*n2co(i)
+                                !
+               k20xc = 3.e-12 * rfvto3p
+               k20cp1 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu1 )
+               k20cp2 = k20xc * 2.0 * exp( -ee/pt(j,i) * nu2 )
+                                !
+               k21xc = 2.49e-11 * 0.5 * rfvv
+               k21cp2 = k21xc * exp( - ee/pt(j,i) * (nu2-nu1) )
+                                !
+               l1 = d19c + k20xc*o3p(i) + k21cp2*n2
+               p1 = ( d19cp1 + k20cp1*o3p(i) ) * n1
+               p12 = k21xc*n1
+                                !
+               l2 = d19c + k20xc*o3p(i) + k21xc*n1
+               p2 = ( d19cp2 + k20cp2*o3p(i) ) * n2
+               p21 = k21cp2*n2
+
+c radiative rates
+               ae1 = 1.3546 * 1.66 / 4.0 * escf1(i)
+               ae2 = ( 1.3452 + 1.1878 ) * 1.66 / 4.0 * escf2(i)
+               l1 = l1 + ae1
+               l2 = l2 + ae2
+
+c solving the system
+               c1 = gamma*nu1**3. * 0.5
+               c2 = gamma*nu2**3. * 0.5
+               a1 = c1 * p1 / (n1*l1)
+               a2 = c2 * p2 / (n2*l2)
+               a12 = (nu1/nu2)**3. * n2/n1 * p12/l1
+               a21 = (nu2/nu1)**3. * n1/n2 * p21/l2
+               el2 = (a2 + a21 * a1 ) / ( 1.0 - a21 * a12 )
+               el1 = a1 + a12 * el2
+               pl1 = el1 * n1 / c1
+               pl2 = el2 * n2 / c2
+
+c  heating rate
+               hr1 = - hplanck*vlight * nu1 * ae1 * pl1
+               hr2 = - hplanck*vlight * nu2 * ae2 * pl2
+               hr(i) = hr1 + hr2
+               dtnlte(j,i)=0.1*hr(i)*pt(j,i)/(4.4*pyy(i)) ! dtnlte in K s-1
+c              write(7,25)pxx(i),hr1,hr2,hr(i),qt
+c  25         format(' ',1p5e12.4)
+
+            endif
+
+         enddo  ! end loop over layers
+      enddo     ! end loop over grid points
+c     close(7)
+c
+        return
+        end
+
+c***********************************************************************
+
+      subroutine interp1(escout,p,nlayer,escin,pin,nl)
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if(p(n1) .gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            escout(n1) = 0.0
+         else
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            escout(n1) = escin(nm)*wm + escin(np)*wp
+         endif
+      enddo
+      return
+      end
+
+c***********************************************************************
+
+      subroutine interp3(esco1,esco2,esco3,p,nlayer,
+     1     esci1,esci2,esci3,pin,nl)
+C
+C subroutine to perform 3 simultaneous linear interpolations in pressure from 
+C 1D profiles esci1-3(nl) sampled on pressure grid pin(nl) to 1D profiles 
+C esco1-3(nlayer) on pressure grid p(ngrid,nlayer).
+C
+      real esco1(nlayer),esco2(nlayer),esco3(nlayer),p(nlayer)
+      real esci1(nl),    esci2(nl),    esci3(nl),    pin(nl),wm,wp
+      integer nl,nlayer,n1,n,nm,np
+      do n1=1,nlayer
+         if (p(n1).gt. 3.5 .or. p(n1) .lt. 4.0e-6) then
+            esco1(n1)=0.0
+            esco2(n1)=0.0
+            esco3(n1)=0.0
+         else 
+            do n = 1,nl-1
+               if (p(n1).le.pin(n).and.p(n1).ge.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(np)-p(n1))/(pin(nm)-pin(np))
+                  wp=1.0 - wm
+               endif
+            enddo
+            esco1(n1) = esci1(nm)*wm + esci1(np)*wp
+            esco2(n1) = esci2(nm)*wm + esci2(np)*wp
+            esco3(n1) = esci3(nm)*wm + esci3(np)*wp
+         endif
+      enddo
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltedata.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltedata.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nltedata.h	(revision 46)
@@ -0,0 +1,166 @@
+c INCLUDE nlte_escape.h
+       !
+       ! Escape functions and VMRs from tabulated values.
+       ! Origin: nlte_escape.dat file form Miguel L.
+       ! (Y. Wanherdrick, 09/2000)
+
+       integer     np
+       parameter ( np = 68 )                ! # data points in tabulation
+       real        pnb(np)                  ! Pressure in tabulation
+       real        ef1(np)                  ! Esc.funct.#1, tabulated
+       real        ef2(np)                  ! Esc.funct.#2, tabulated
+       real        co2vmr(np)               ! CO2 VMR tabulated
+       real        o3pvmr(np)               ! CO2 VMR tabulated
+       real        n2covmr(np)              ! N2+CO VMR tabulated
+ 
+ 
+      DATA pnb/
+     &    12.0000,    11.0000,    10.8000,
+     &    10.6000,   10.40000,   10.20000,
+     &   10.00000,    9.80000,    9.60000,
+     &    9.40000,    9.20000,    9.00000,
+     &    8.80000,    8.60000,    8.40000,
+     &    8.20000,    8.00000,    7.80000,
+     &    7.60000,    7.40000,    7.20000,
+     &    7.00000,    6.80000,    6.60000,
+     &    6.40000,    6.20000,    6.00000,
+     &    5.80000,    5.60000,    5.40000,
+     &    5.20000,    5.00000,    4.80000,
+     &    4.60000,    4.40000,    4.20000,
+     &    4.00000,    3.80000,    3.60000,
+     &    3.40000,    3.20000,    3.00000,
+     &    2.80000,    2.60000,    2.40000,
+     &    2.20000,    2.00000,    1.80000,
+     &    1.60000,    1.40000,    1.20000,
+     &    1.00000,   0.800000,   0.599999,
+     &   0.400000,   0.200000,  0.,
+     &  -0.200000,  -0.400001,  -0.600000,
+     &  -0.800000,   -1.00000,   -1.20000,
+     &   -1.40000,   -1.60000,   -1.80000,
+     &   -2.00000,   -3.00000/
+ 
+      DATA ef1/
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.58112E-04,    4.58112E-04,
+     &    4.58112E-04,    4.61707E-04,    4.76886E-04,
+     &    4.95638E-04,    5.20935E-04,    5.55511E-04,
+     &    6.01219E-04,    6.63734E-04,    7.50691E-04,
+     &    8.63474E-04,    1.00900E-03,    1.19642E-03,
+     &    1.42690E-03,    1.71398E-03,    2.06663E-03,
+     &    2.48974E-03,    3.01578E-03,    3.64350E-03,
+     &    4.40323E-03,    5.32066E-03,    6.40456E-03,
+     &    7.72069E-03,    9.25684E-03,    1.10905E-02,
+     &    1.32374E-02,    1.57643E-02,    1.87388E-02,
+     &    2.22072E-02,    2.63099E-02,    3.10614E-02,
+     &    3.66948E-02,    4.32373E-02,    5.15022E-02,
+     &    6.21455E-02,    7.77212E-02,    9.92027E-02,
+     &   0.131155,   0.179470,   0.258913,
+     &   0.380549,   0.530450,   0.643180,
+     &   0.741061,   0.826336,   0.922787,
+     &   0.997203,    1.00000/
+ 
+      DATA ef2/
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    1.98992E-03,
+     &    1.98992E-03,    1.98992E-03,    2.01376E-03,
+     &    2.09450E-03,    2.22993E-03,    2.42056E-03,
+     &    2.68018E-03,    3.04398E-03,    3.43896E-03,
+     &    3.80282E-03,    4.20622E-03,    4.76121E-03,
+     &    8.01698E-03,    1.19947E-02,    1.69149E-02,
+     &    2.24497E-02,    2.85244E-02,    3.54813E-02,
+     &    4.39264E-02,    5.46248E-02,    6.75367E-02,
+     &    8.29931E-02,    1.01717E-01,   0.123422,
+     &   0.148468,   0.177096,   0.208816,
+     &   0.244003,   0.282013,   0.322559,
+     &   0.365542,   0.410518,   0.457384,
+     &   0.505358,   0.553627,   0.600472,
+     &   0.644807,   0.687185,   0.727429,
+     &   0.764734,   0.798562,   0.828699,
+     &   0.854797,   0.877717,   0.897874,
+     &   0.915258,   0.929904,   0.942381,
+     &   0.952906,   0.962173,   0.970191,
+     &   0.976437,   0.981501,   0.985406,
+     &   0.988560,   0.991111,   0.993653,
+     &   0.995561,    1.00000/
+ 
+      DATA co2vmr/
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.950000,   0.950000,   0.950000,
+     &   0.949619,   0.947694,   0.945830,
+     &   0.944016,   0.940557,   0.937068,
+     &   0.932366,   0.893661/
+ 
+      DATA o3pvmr/
+     &    5.06756E-08,    9.16539E-07,    1.68217E-06,
+     &    3.00843E-06,    5.03151E-06,    8.07489E-06,
+     &    1.23137E-05,    1.79029E-05,    2.45308E-05,
+     &    3.27431E-05,    4.26692E-05,    5.44396E-05,
+     &    6.78865E-05,    8.33147E-05,    1.00148E-04,
+     &    1.18846E-04,    1.39681E-04,    1.64909E-04,
+     &    1.93617E-04,    2.25161E-04,    2.60834E-04,
+     &    3.01501E-04,    3.44953E-04,    3.91011E-04,
+     &    4.40377E-04,    4.90820E-04,    5.43200E-04,
+     &    5.95335E-04,    6.45420E-04,    6.93166E-04,
+     &    7.43729E-04,    7.93710E-04,    8.44394E-04,
+     &    8.94318E-04,    9.44732E-04,    9.94964E-04,
+     &    1.04901E-03,    1.10008E-03,    1.16302E-03,
+     &    1.22989E-03,    1.30026E-03,    1.37131E-03,
+     &    1.45556E-03,    1.55186E-03,    1.66328E-03,
+     &    1.77802E-03,    1.91546E-03,    2.07503E-03,
+     &    2.24903E-03,    2.47117E-03,    2.71728E-03,
+     &    2.99739E-03,    3.33582E-03,    3.73507E-03,
+     &    4.20819E-03,    4.76887E-03,    5.42558E-03,
+     &    6.20815E-03,    7.14473E-03,    8.28545E-03,
+     &    9.51779E-03,    1.08140E-02,    1.22359E-02,
+     &    1.36870E-02,    1.51495E-02,    1.67196E-02,
+     &    1.85485E-02,    3.36252E-02/
+ 
+      DATA n2covmr/
+     &    2.71412E-02,    2.71464E-02,    2.71490E-02,
+     &    2.71523E-02,    2.71558E-02,    2.71617E-02,
+     &    2.71672E-02,    2.71749E-02,    2.71837E-02,
+     &    2.71943E-02,    2.72058E-02,    2.72189E-02,
+     &    2.72326E-02,    2.72483E-02,    2.72661E-02,
+     &    2.72848E-02,    2.73054E-02,    2.73279E-02,
+     &    2.73514E-02,    2.73775E-02,    2.74048E-02,
+     &    2.74345E-02,    2.74672E-02,    2.75021E-02,
+     &    2.75404E-02,    2.75826E-02,    2.76340E-02,
+     &    2.77013E-02,    2.78220E-02,    2.79707E-02,
+     &    2.81759E-02,    2.84339E-02,    2.87587E-02,
+     &    2.91600E-02,    2.96561E-02,    3.02558E-02,
+     &    3.09922E-02,    3.18062E-02,    3.27010E-02,
+     &    3.35635E-02,    3.44388E-02,    3.53327E-02,
+     &    3.62143E-02,    3.70941E-02,    3.79315E-02,
+     &    3.87626E-02,    3.95524E-02,    4.03071E-02,
+     &    4.10071E-02,    4.16229E-02,    4.21231E-02,
+     &    4.25167E-02,    4.27964E-02,    4.29773E-02,
+     &    4.30488E-02,    4.29638E-02,    4.28049E-02,
+     &    4.26788E-02,    4.26822E-02,    4.29426E-02,
+     &    4.34634E-02,    4.42559E-02,    4.53038E-02,
+     &    4.65879E-02,    4.80262E-02,    4.96303E-02,
+     &    5.14885E-02,    6.91651E-02/
+ 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlteparams.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlteparams.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlteparams.h	(revision 46)
@@ -0,0 +1,18 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'nlteparams.h'
+c
+c   Parameters which govern the transition from LTE to NLTE radiation
+c   tendencies.
+c-----------------------------------------------------------------------
+
+      real ptrans           ! central pressure for transition (Pa)
+      parameter (ptrans = 0.1)
+      real zw               ! half-width for transition (scale heights)
+      parameter (zw = 0.5)
+      real pminte           ! pressure up to which LTE is calculated (Pa)
+      parameter (pminte = 0.4*ptrans)
+c     almost one scale height above transition in worst case is very safe
+      real zwi
+      parameter (zwi = 2./zw)
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlthermeq.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlthermeq.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nlthermeq.F	(revision 46)
@@ -0,0 +1,58 @@
+      subroutine nlthermeq(ngrid, nlayer, pplev, pplay)
+c
+c  Compute the number of layers nlaylte (stored in common yomlw.h)
+c  over which local thermodynamic equilibrium
+c  radiation scheme should be run to be sure of covering at least to a
+c  height greater than (pressure lower than) p=pminte, set in nlteparams.h.
+c  The maximum layer needed is found for the worst possible case.
+c  Stephen Lewis 6/2000
+c  Modified Y. Wanherdrick/ F. Forget 09/2000
+
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "nlteparams.h"
+#include "yomlw.h"
+#include "callkeys.h"
+
+c
+c     Input:
+      integer ngrid, nlayer
+      real pplev(ngrid, nlayer+1)
+      real pplay(ngrid, nlayer)
+c
+c     Local:
+      integer igpmax, ismax
+      logical firstcall
+      data firstcall /.true./
+      save firstcall, igpmax
+c
+      if(firstcall) then
+c     Find the location of maximum surface pressure.
+c     Location won't vary much so only do it at the start;
+c     with no topography location would vary, but this is only
+c     needed for an estimate so any point would do in that case.
+         igpmax = ismax(ngrid, pplev, 1)
+         write(*, 10) ptrans
+         write(*, 20) zw
+         write(*, 30) pminte
+         firstcall = .false.
+      endif
+c
+      IF(callnlte) then
+c       Find first layer above pminte at this location
+        do nlaylte = nlayer, 1, -1
+           if (pplay(igpmax, nlaylte).gt.pminte)  go to 100
+        enddo
+      ELSE
+        nlaylte=nlayer
+      END IF
+  100 write(*,*) 'LTE rad. calculations up to layer ',  nlaylte
+c
+      return
+c
+   10 format(' nlthermeq: transition to NLTE centred at ',f6.2,'Pa')
+   20 format('               half-width (scale heights) ',f6.2)
+   30 format('          suggested LTE coverage at least ',f6.2,'Pa')
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/calldrag_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/calldrag_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/calldrag_noro.F	(revision 46)
@@ -0,0 +1,143 @@
+      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw) 
+
+
+
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call SUBROUTINE drag_noro 
+c   Interface for sub-grid scale orographic scheme
+c
+c   author:   
+c   ------
+c           Christophe Hourdin/ Francois Forget
+c
+c   changes:
+c   -------
+c   > J.-B. Madeleine 09W30
+c   Removed the variable's splitting, which is now obsolete.
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   ptimestep             Physical timestep (s)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature  (K)
+c   pu(ngrid,nlayer)       zonal wind (m s-1)
+c   pv(ngrid,nlayer)       meridional wind (m s-1)
+c
+c   output:
+c   -------
+c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
+c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
+c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
+c
+c
+c
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer  
+
+      real ptimestep
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
+      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      REAL sigtest(nlayermx+1)
+      INTEGER igwd,igwdim,itest(ngridmx)
+
+      INTEGER l,ig
+
+      REAL zulow(ngridmx),zvlow(ngridmx)
+      REAL zustr(ngridmx),zvstr(ngridmx)
+
+      INTEGER zidx(ngridmx)
+
+      logical ll
+
+
+c   local saved variables
+c   ---------------------
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         do l=1,nlayermx+1
+           sigtest(l)=pplev(1,l)/pplev(1,1)
+         enddo
+         call sugwd(nlayermx,sigtest)
+         firstcall=.false.
+      END IF
+
+c       Detecting points concerned by the scheme
+c       ----------------------------------------
+
+        igwd=0
+        DO ig=1, ngrid
+          itest(ig)=0
+          ll=zstd(ig).gt.50.0
+          IF(ll) then
+            itest(ig)=1
+            igwd=igwd+1
+            zidx(igwd)=ig
+          ENDIF
+        ENDDO
+        IGWDIM=MAX(1,IGWD)
+
+c       Calling gravity wave and subgrid scale topo parameterization
+c       -------------------------------------------------------------
+
+        call drag_noro (ngrid,nlayer,ptimestep,pplay,pplev,
+     e            zstd,zsig,zgam,zthe,
+     e            igwd,igwdim,zidx,itest,
+     e            pt, pu, pv,
+     s            zulow,zvlow,zustr,zvstr,
+     s            pdtgw,pdugw,pdvgw)
+
+
+c       Dividing by ptimestep (true tendancies)
+c       ---------------------------------------
+
+        do l=1,nlayer
+         do ig = 1, ngrid
+          pdtgw(ig,l) = pdtgw(ig,l)/ptimestep
+          pdugw(ig,l) = pdugw(ig,l)/ptimestep
+          pdvgw(ig,l) = pdvgw(ig,l)/ptimestep
+         enddo
+        enddo
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/drag_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/drag_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/drag_noro.F	(revision 46)
@@ -0,0 +1,166 @@
+      SUBROUTINE drag_noro (klon,klev,dtime,pplay,pplev,
+     e                   pvar, psig, pgam, pthe,
+     e                   kgwd,kgwdim,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+C**** *DRAG_NORO* INTERFACE FOR SUB-GRID SCALE OROGRAPHIC SCHEME
+C
+C     PURPOSE.
+C     --------
+C           ZEROS TENDENCIES, COMPUTES GEOPOTENTIAL HEIGHT AND UPDATES THE
+C           TENDENCIES AFTER THE SCHEME HAS BEEN CALLED.
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     DTIME              : LENGTH OF TIME STEP
+C     PPLAY(NLON,NLEV+1) : PRESSURE AT MIDDLE LEVELS
+C     PPLEV(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PVAR(NLON)         : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAM(NLON)         : SUB-GRID SCALE ANISOTROPY
+C     PTHE(NLON)         : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     T(NLON,NLEV)       : TEMPERATURE
+C     U(NLON,NLEV)       : ZONAL WIND
+C     V(NLON,NLEV)       : MERIDIONAL WIND
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PUSTR(NLON)        : LOW LEVEL ZONAL STRESS
+C     PVSTR(NLON)        : LOW LEVEL MERIDIONAL STRESS
+C     D_T(NLON,NLEV)     : TEMPERATURE TENDENCY
+C     D_U(NLON,NLEV)     : ZONAL WIND TENDENCY
+C     D_V(NLON,NLEV)     : MERIDIONAL WIND TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C
+c
+      IMPLICIT none
+c======================================================================
+c Auteur(s): Z.X. Li F.Lott (LMD/CNRS) date: 19950201
+c Objet: Frottement de la montagne Interface
+c======================================================================
+c Arguments:
+c dtime---input-R- pas d'integration (s)
+c s-------input-R-la valeur "s" pour chaque couche
+c pplay--input-R- pression au milieu des couches en Pa
+c pplev--input-R-pression au bords des couches en Pa
+c t-------input-R-temperature (K)
+c u-------input-R-vitesse horizontale (m/s)
+c v-------input-R-vitesse horizontale (m/s)
+c
+c d_t-----output-R-increment de la temperature t
+c d_u-----output-R-increment de la vitesse u
+c d_v-----output-R-increment de la vitesse v
+c======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+c
+c ARGUMENTS
+c
+      REAL dtime
+      INTEGER klon,klev
+      real pplay(NDLO2,klev),pplev(NDLO2,klev+1)
+      REAL pvar(NDLO2),psig(NDLO2),pgam(NDLO2),pthe(NDLO2)
+      REAL pulow(NDLO2),pvlow(NDLO2),pustr(NDLO2),pvstr(NDLO2)
+      REAL u(NDLO2,klev), v(NDLO2,klev),t(NDLO2,klev)
+      REAL d_t(NDLO2,klev), d_u(NDLO2,klev), d_v(NDLO2,klev)
+c
+      INTEGER i, k, kgwd, kgwdim, kdx(NDLO2), ktest(NDLO2)
+c
+c Variables locales:
+c
+      REAL paprs(NDLO2,nlayermx+1)
+      REAL paprsf(NDLO2,nlayermx)
+      REAL zgeom(NDLO2,nlayermx)
+      REAL pdtdt(NDLO2,nlayermx)
+      REAL pdudt(NDLO2,nlayermx), pdvdt(NDLO2,nlayermx)
+      REAL pt(NDLO2,nlayermx), pu(NDLO2,nlayermx)
+      REAL pv(NDLO2,nlayermx)
+c
+c initialiser les variables de sortie (pour securite)
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c preparer les variables d'entree (attention: l'ordre des niveaux 
+c verticaux augmente du haut vers le bas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1)
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         paprsf(i,k) = pplay(i,klev-k+1)
+         paprs(i,k) = pplev(i,klev+1-k+1)
+      ENDDO
+      ENDDO
+      DO i = 1, klon
+         paprs(i,klev+1) = pplev(i,1)
+      ENDDO
+      DO i = 1, klon
+         zgeom(i,klev) = r * pt(i,klev)
+     .                  * LOG(paprs(i,klev+1)/paprsf(i,klev))
+      ENDDO
+      DO k = klev-1, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = zgeom(i,k+1) + r * (pt(i,k)+pt(i,k+1))/2.0
+     .               * LOG(paprsf(i,k+1)/paprsf(i,k))
+      ENDDO
+      ENDDO
+c
+c appeler la routine principale
+c
+
+      CALL ORODRAG(klon,klev,kgwd,kgwdim,kdx,ktest,
+     .            dtime,
+     .            paprs, paprsf, zgeom,
+     .            pt, pu, pv, pvar, psig, pgam, pthe,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +g*pdudt(i,k)*(paprs(i,k+1)-paprs(i,k))
+         pvstr(i)        = pvstr(i)
+     .                    +g*pdvdt(i,k)*(paprs(i,k+1)-paprs(i,k))
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwprofil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwprofil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwprofil.F	(revision 46)
@@ -0,0 +1,216 @@
+      SUBROUTINE GWPROFIL
+     *         ( klon, klev
+     *         , kgwd ,kdx  , ktest
+     *         , KKCRIT, KKCRITH, KCRIT ,  kkenvh, kknu,kknu2
+     *         , PAPHM1, PRHO   , PSTAB , PTFR , PVPH , PRI , PTAU
+     *         , ptauf ,pdmod   , pnu   , psig ,pgamma, pvar      )
+
+C**** *GWPROFIL*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD:
+C     -------
+C     THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
+C     IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
+C     AND THE TOP OF THE BLOCKED LAYER (KKENVH).
+C     IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE 
+C     BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR 
+C     NONLINEAR GRAVITY WAVE BREAKING.
+C     ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
+C     LEVEL (KCRIT) OR WHEN IT BREAKS.
+C     
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer kgwd
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2)
+     *       ,kdx(NDLO2),ktest(NDLO2)
+     *       ,kkenvh(NDLO2),kknu(NDLO2),kknu2(NDLO2)
+C
+      REAL PAPHM1(NDLO2,klev+1), PSTAB(NDLO2,klev+1),
+     *     PRHO  (NDLO2,klev+1), PVPH (NDLO2,klev+1),
+     *     PRI   (NDLO2,klev+1), PTFR (NDLO2), PTAU(NDLO2,klev+1),
+     *     ptauf (NDLO2,klev+1)
+     
+      REAL pdmod (NDLO2) , pnu (NDLO2) , psig(NDLO2),
+     *     pgamma(NDLO2) , pvar(NDLO2)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+c   declarations pour 'implicit none"
+      real zsqr,zalfa,zriw,zalpha,zb,zdel,zdz2n,zdelp,zdelpt
+
+      integer ji,jk,jl,ilevh
+      REAL ZDZ2 (NDLO2,nlayermx) , ZNORM(NDLO2) , zoro(NDLO2)
+      REAL ZTAU (NDLO2,nlayermx+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      ilevh=KLEV/3
+C
+      DO 400 ji=1,kgwd
+      jl=kdx(ji)
+      Zoro(JL)=Psig(JL)*Pdmod(JL)/4./max(pvar(jl),1.0)
+      ZTAU(JL,KKNU(JL)+1)=PTAU(JL,KKNU(JL)+1)
+      ZTAU(JL,KLEV+1)=PTAU(JL,KLEV+1)
+  400 CONTINUE
+C
+      DO 430 JK=KLEV,2,-1
+C
+C
+C*         4.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
+C                 BLOCKING LAYER.
+  410 CONTINUE
+C
+      DO 411 ji=1,kgwd
+      jl=kdx(ji)
+           IF(JK.GE.KKNU2(JL)) THEN
+           PTAU(JL,JK)=ZTAU(JL,KLEV+1)
+           ENDIF
+ 411  CONTINUE             
+C
+C*         4.15   CONSTANT SHEAR STRESS UNTIL THE TOP OF THE
+C                 LOW LEVEL FLOW LAYER.
+ 415  CONTINUE
+C        
+C
+C*         4.2    WAVE DISPLACEMENT AT NEXT LEVEL.
+C
+  420 CONTINUE
+C
+      DO 421 ji=1,kgwd
+      jl=kdx(ji)
+      IF(JK.LT.KKNU2(JL)) THEN
+      ZNORM(JL)=gkdrag*PRHO(JL,JK)*SQRT(PSTAB(JL,JK))*PVPH(JL,JK)
+     *                                                    *zoro(jl)
+      ZDZ2(JL,JK)=PTAU(JL,JK+1)/max(ZNORM(JL),gssec)
+      ENDIF
+  421 CONTINUE
+C
+C*         4.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
+C*                AND STRESS:  BREAKING EVALUATION AND CRITICAL 
+C                 LEVEL
+C
+      DO 431 ji=1,kgwd
+      jl=kdx(ji)
+          IF(JK.LT.KKNU2(JL)) THEN
+          IF((PTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.KCRIT(JL))) THEN
+            PTAU(JL,JK)=0.0
+          ELSE
+               ZSQR=SQRT(PRI(JL,JK))
+               ZALFA=SQRT(PSTAB(JL,JK)*ZDZ2(JL,JK))/PVPH(JL,JK)
+               ZRIW=PRI(JL,JK)*(1.-ZALFA)/(1+ZALFA*ZSQR)**2
+               IF(ZRIW.LT.GRCRIT) THEN
+                 ZDEL=4./ZSQR/GRCRIT+1./GRCRIT**2+4./GRCRIT
+                 ZB=1./GRCRIT+2./ZSQR
+                 ZALPHA=0.5*(-ZB+SQRT(ZDEL))
+                 ZDZ2N=(PVPH(JL,JK)*ZALPHA)**2/PSTAB(JL,JK)
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2N
+               ELSE
+                 PTAU(JL,JK)=ZNORM(JL)*ZDZ2(JL,JK)
+               ENDIF
+            PTAU(JL,JK)=MIN(PTAU(JL,JK),PTAU(JL,JK+1))
+          ENDIF
+          ENDIF
+  431 CONTINUE
+  
+  430 CONTINUE
+  440 CONTINUE
+  
+c     write(*,*) 'ptau'
+c     write(*,99) ((ji,ilevh,ptau(ji,ilevh),ji=1,NDLO2),
+c    .                  ilevh=1,nlayermx+1)
+ 99   FORMAT(i3,i3,f15.5)
+
+
+C  REORGANISATION OF THE STRESS PROFILE
+C  IF BREAKING OCCURS AT LOW LEVEL:
+
+      DO 530 ji=1,kgwd
+      jl=kdx(ji)
+      ZTAU(JL,KKENVH(JL))=PTAU(JL,KKENVH(JL))
+      ZTAU(JL,KKCRITH(JL))=PTAU(JL,KKCRITH(JL))
+ 530  CONTINUE      
+
+      DO 531 JK=1,KLEV
+      
+      DO 532 ji=1,kgwd
+      jl=kdx(ji)
+                
+         IF(JK.GT.KKCRITH(JL).AND.JK.LT.KKENVH(JL))THEN
+
+          ZDELP=PAPHM1(JL,JK)-PAPHM1(JL,KKENVH(JL))
+          ZDELPT=PAPHM1(JL,KKCRITH(JL))-PAPHM1(JL,KKENVH(JL))
+          PTAU(JL,JK)=ZTAU(JL,KKENVH(JL)) +
+     .                (ZTAU(JL,KKCRITH(JL))-ZTAU(JL,KKENVH(JL)) )*
+     .                ZDELP/ZDELPT
+     
+        ENDIF
+            
+ 532  CONTINUE    
+ 
+ 531  CONTINUE        
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwstress.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwstress.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/gwstress.F	(revision 46)
@@ -0,0 +1,134 @@
+      SUBROUTINE GWSTRESS
+     *         (  klon  , klev
+     *         , KKCRIT, KSECT, KKHLIM, KTEST, KKCRITH, KCRIT, kkenvh
+     *         , kknu
+     *         , PRHO  , PSTAB, PVPH  , PVAR ,PVARor, psig  
+     *         , PTFR  , PTAU  
+     *         ,pgeom1 , pgamma, pd1  , pd2   ,pdmod ,pnu )
+C
+C**** *GWSTRESS*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C     CALL *GWSTRESS*  FROM *GWDRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F. LOTT PUT THE NEW GWD ON IFS      22/11/93
+C
+C-----------------------------------------------------------------------
+      implicit none
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),KKENVH(NDLO2),KKNU(NDLO2)
+C
+      REAL PRHO(NDLO2,klev+1),PSTAB(NDLO2,klev+1),PTAU(NDLO2,klev+1),
+     *     PVPH(NDLO2,klev+1),PVAR(NDLO2,4),PTFR(NDLO2),
+     *     pgeom1(NDLO2,klev),PVARor(NDLO2)
+C
+      real pd1(NDLO2),pd2(NDLO2),pnu(NDLO2),psig(NDLO2),pgamma(NDLO2)
+      real pdmod(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      integer jl
+      real zblock,zvar,zeff
+      logical lo
+
+C
+C-----------------------------------------------------------------------
+C
+C*       0.3   FUNCTIONS
+C              ---------
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+
+
+      kidia=1
+      kfdia=klon
+
+
+C
+ 100  CONTINUE
+C
+C*         3.1     GRAVITY WAVE STRESS.
+C
+  300 CONTINUE
+C
+C
+      DO 301 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      
+C  EFFECTIVE MOUNTAIN HEIGHT ABOVE THE BLOCKED FLOW
+  
+c        IF(KKENVH(JL).EQ.KLEV)THEN
+         ZBLOCK=0.0 
+c        ELSE
+c         ZBLOCK=(PGEOM1(JL,KKENVH(JL))+PGEOM1(JL,KKENVH(JL)+1))/2./RG          
+c        ENDIF
+      
+        ZVAR=PVAROR(JL)
+        ZEFF=AMAX1(0.,2.*ZVAR-ZBLOCK)
+
+        PTAU(JL,KLEV+1)=PRHO(JL,KLEV+1)*GKDRAG*psig(jl)*ZEFF**2
+     *    /4./ZVAR*PVPH(JL,KLEV+1)*pdmod(jl)*sqrt(pstab(jl,klev+1))
+
+C  TOO SMALL VALUE OF STRESS OR  LOW LEVEL FLOW INCLUDE CRITICAL LEVEL
+C  OR LOW LEVEL FLOW:  GRAVITY WAVE STRESS NUL.
+                
+        LO=(PTAU(JL,KLEV+1).LT.GTSEC).OR.(KCRIT(JL).GE.KKNU(JL))
+     *      .OR.(PVPH(JL,KLEV+1).LT.GVCRIT)
+c       IF(LO) PTAU(JL,KLEV+1)=0.0
+      
+      ELSE
+      
+          PTAU(JL,KLEV+1)=0.0
+          
+      ENDIF
+      
+  301 CONTINUE
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orodrag.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orodrag.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orodrag.F	(revision 46)
@@ -0,0 +1,286 @@
+      SUBROUTINE ORODRAG( klon,klev 
+     I                 , KGWD, KGWDIM, KDX, KTEST
+     R                 , PTSPHY
+     R                 , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1
+     R                 , PVM1, PVAROR, PSIG, PGAMMA, PTHETA
+C OUTPUTS
+     R                 , PULOW,PVLOW
+     R                 , PVOM,PVOL,PTE )
+C
+C
+C**** *ORODRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION.
+C
+C     PURPOSE.
+C     --------
+C
+C          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
+C          PROGNOSTIC VARIABLES U,V  AND T DUE TO  VERTICAL TRANSPORTS BY
+C          SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
+C
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C
+C     INPUT :
+C
+C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
+C     NLEV               : NUMBER OF LEVELS
+C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
+C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
+C     KTEST(NLON)        : MAP OF CALLING POINTS
+C     PTSPHY             : LENGTH OF TIME STEP
+C     PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS
+C     PAPM1(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
+C     PGEOM1(NLON,NLEV)  : GEOPOTENTIAL HIEGHT OF MODEL LEVELS
+C     PTM1(NLON,NLEV)    : TEMPERATURE
+C     PUM1(NLON,NLEV)    : ZONAL WIND
+C     PVM1(NLON,NLEV)    : MERIDIONAL WIND
+C     PVAROR(NLON)       : SUB-GRID SCALE STANDARD DEVIATION
+C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
+C     PGAMMA(NLON)       : SUB-GRID SCALE ANISOTROPY
+C     PTHETA(NLON)       : SUB-GRID SCALE PRINCIPAL AXES ANGLE
+C
+C     OUTPUT :
+C
+C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
+C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
+C     PVOM(NLON,NLEV)    : ZONAL WIND TENDENCY
+C     PVOL(NLON,NLEV)    : MERIDIONAL WIND TENDENCY
+C     PTE(NLON,NLEV)     : TEMPERATURE TENDENCY
+C
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C
+C     comcstfi.h
+C     dimphys.h
+C     yoegwd.h
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C     REFERENCE.
+C     ----------
+C
+C     AUTHOR.
+C     -------
+C     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.
+C
+C     F.LOTT + M. MILLER    E.C.M.W.F.     22/11/94
+C-----------------------------------------------------------------------
+      implicit none
+C
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+      parameter(kidia=1,kfdia=NDLO2)
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+C
+      REAL  PTE(NDLO2,klev),
+     *      PVOL(NDLO2,klev),
+     *      PVOM(NDLO2,klev),
+     *      PULOW(NDLO2),
+     *      PVLOW(NDLO2)
+      REAL  PUM1(NDLO2,klev),
+     *      PVM1(NDLO2,klev),
+     *      PTM1(NDLO2,klev),
+     *      PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2),
+     *      PGEOM1(NDLO2,klev),
+     *      PAPM1(NDLO2,klev),
+     *      PAPHM1(NDLO2,klev+1)
+C
+      integer kgwd,kgwdim
+      real ptsphy
+      INTEGER  KDX(NDLO2),KTEST(NDLO2)
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+      INTEGER  ISECT(NDLO2),
+     *         ICRIT(NDLO2),
+     *         IKCRITH(NDLO2),
+     *         IKenvh(NDLO2),
+     *         IKNU(NDLO2),
+     *         IKNU2(NDLO2),
+     *         IKCRIT(NDLO2),
+     *         IKHLIM(NDLO2)
+      integer ji,jk,jl,klevm1,ilevp1
+C      real gkwake
+      real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
+      real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
+C
+      REAL   ZTAU(NDLO2,nlayermx+1),
+     *       ZSTAB(NDLO2,nlayermx+1),
+     *       ZVPH(NDLO2,nlayermx+1),
+     *       ZRHO(NDLO2,nlayermx+1),
+     *       ZRI(NDLO2,nlayermx+1),
+     *       ZpsI(NDLO2,nlayermx+1),
+     *       Zzdep(NDLO2,nlayermx)
+      REAL   ZDUDT(NDLO2),
+     *       ZDVDT(NDLO2),
+     *       ZDTDT(NDLO2),
+     *       ZDEDT(NDLO2),
+     *       ZVIDIS(NDLO2),
+     *       ZTFR(NDLO2),
+     *       Znu(NDLO2),
+     *       Zd1(NDLO2),
+     *       Zd2(NDLO2),
+     *       Zdmod(NDLO2)
+C
+C------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+ 110  CONTINUE
+C
+c     ZTMST=TWODT
+c     IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
+      KLEVM1=KLEV-1
+      ZTMST=PTSPHY
+      ZRTMST=1./ZTMST
+C     ------------------------------------------------------------------
+C
+ 120  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.3   CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
+C                ---------------------------------------------
+C
+ 130  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.     PRECOMPUTE BASIC STATE VARIABLES.
+C*                ---------- ----- ----- ----------
+C*                DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+  200 CONTINUE
+C
+C
+C
+      CALL OROSETUP
+     *     ( klon, klev , KTEST 
+     *     , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2
+     *     , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1 , PGEOM1, pvaror
+     *     , ZRHO  , ZRI   , ZSTAB  , ZTAU , ZVPH , zpsi, zzdep
+     *     , PULOW, PVLOW 
+     *     , ptheta,pgamma,znu  ,zd1,  zd2,  zdmod                )
+C
+C
+C
+C***********************************************************
+C
+C
+C*         3.      COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
+C*                 SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
+C*                 AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
+C
+  300 CONTINUE
+C
+      CALL GWSTRESS
+     *    ( klon  , klev
+     *    , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU
+     *    , ZRHO  , ZSTAB, ZVPH  , PVAR , pvaror,  psig
+     *    , ZTFR   , ZTAU 
+     *    , pgeom1,pgamma,zd1,zd2,zdmod,znu)
+C
+C*         4.      COMPUTE STRESS PROFILE.
+C*                 ------- ------ --------
+C
+  400 CONTINUE
+C
+C
+      CALL GWPROFIL
+     *       (  klon , klev
+     *       , kgwd   , kdx  , KTEST
+     *       , IKCRIT, IKCRITH, ICRIT  , ikenvh, IKNU
+     *       ,iknu2 , pAPHM1, ZRHO   , ZSTAB , ZTFR   , ZVPH
+     *       , ZRI   , ZTAU   , ztauf
+     *       , zdmod , znu    , psig  , pgamma , pvaror   )
+C
+C
+C*         5.      COMPUTE TENDENCIES.
+C*                 -------------------
+C
+  500 CONTINUE
+C
+C  EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
+C  IMPLICIT SOLUTION FOR THE BLOCKED LEVELS
+
+      DO 510 JL=KIDIA,KFDIA
+      ZVIDIS(JL)=0.0
+      ZDUDT(JL)=0.0
+      ZDVDT(JL)=0.0
+      ZDTDT(JL)=0.0
+  510 CONTINUE
+C
+      ILEVP1=KLEV+1
+C
+C
+      DO 524 JK=1,klev
+C
+CDIR$ IVDEP
+C
+C      GKWAKE=0.5
+C
+C     NOW SET IN SUGWD.F
+C
+      DO 523 JL=1,KGWD
+      JI=KDX(JL)
+      ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK)
+      ZTEMP=-g*(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)*ZDELP)
+      ZDUDT(JI)=(PULOW(JI)*Zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      ZDVDT(JI)=(pvLOW(JI)*Zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      if(jk.ge.ikenvh(ji)) then
+         zb=1.0-0.18*pgamma(ji)-0.04*pgamma(ji)**2
+         zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2
+         zconb=2.*ztmst*GKWAKE*psig(ji)/(4.*pvaror(ji))
+         zabsv=sqrt(PUM1(JI,JK)**2+PVM1(JI,JK)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgamma(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgamma(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      PVOM(JI,JK)=ZDUDT(JI)
+      PVOL(JI,JK)=ZDVDT(JI)
+      ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI)
+      ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI)
+      ZDIS=0.5*(PUM1(JI,JK)**2+PVM1(JI,JK)**2-ZUST**2-ZVST**2)
+      ZDEDT(JI)=ZDIS/ZTMST
+      ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP
+      ZDTDT(JI)=ZDEDT(JI)/cpp
+      PTE(JI,JK)=ZDTDT(JI)
+
+  523 CONTINUE
+
+  524 CONTINUE
+C
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orosetup.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orosetup.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/orosetup.F	(revision 46)
@@ -0,0 +1,494 @@
+      SUBROUTINE OROSETUP
+     *         ( klon   , klev  , KTEST
+     *         , KKCRIT, KKCRITH, KCRIT, KSECT , KKHLIM
+     *         , kkenvh, kknu  , kknu2
+     *         , PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1  , PGEOM1, pvaror
+     *         , PRHO  , PRI   , PSTAB  , PTAU , PVPH  ,ppsi, pzdep
+     *         , PULOW , PVLOW  
+     *         , Ptheta, pgamma,  pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+C**** *GWSETUP*
+C
+C     PURPOSE.
+C     --------
+C
+C**   INTERFACE.
+C     ----------
+C          FROM *ORODRAG*
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS ===
+C     ==== OUTPUTS ===
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C
+C     EXTERNALS.
+C     ----------
+C
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."
+C
+C     AUTHOR.
+C     -------
+C
+C     MODIFICATIONS.
+C     --------------
+C     F.LOTT  FOR THE NEW-GWDRAG SCHEME NOVEMBER 1993
+C
+C-----------------------------------------------------------------------
+      implicit none
+C
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+      integer klon,klev,kidia,kfdia
+
+#include "comcstfi.h"
+#include "yoegwd.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      INTEGER KKCRIT(NDLO2),KKCRITH(NDLO2),KCRIT(NDLO2),KSECT(NDLO2),
+     *        KKHLIM(NDLO2),KTEST(NDLO2),kkenvh(NDLO2)
+
+C
+      REAL PAPHM1(NDLO2,KLEV+1),PAPM1(NDLO2,KLEV),PUM1(NDLO2,KLEV),
+     *     PVM1(NDLO2,KLEV),PTM1(NDLO2,KLEV),PGEOM1(NDLO2,KLEV),
+     *     PRHO(NDLO2,KLEV+1),PRI(NDLO2,KLEV+1),PSTAB(NDLO2,KLEV+1),
+     *     PTAU(NDLO2,KLEV+1),PVPH(NDLO2,KLEV+1),ppsi(NDLO2,klev+1),
+     *     pzdep(NDLO2,klev)
+       REAL PULOW(NDLO2),PVLOW(NDLO2),ptheta(NDLO2),pgamma(NDLO2),
+     *     pnu(NDLO2),
+     *     pd1(NDLO2),pd2(NDLO2),pdmod(NDLO2)
+      real pvaror(NDLO2)
+C
+C-----------------------------------------------------------------------
+C
+C*       0.2   LOCAL ARRAYS
+C              ------------
+C
+C
+      LOGICAL LL1(NDLO2,nlayermx+1)
+      integer kknu(NDLO2),kknu2(NDLO2),kknub(NDLO2),kknul(NDLO2),
+     *        kentp(NDLO2),ncount(NDLO2)  
+C
+      REAL ZHCRIT(NDLO2,nlayermx),ZNCRIT(NDLO2,nlayermx),
+     *     ZVPF(NDLO2,nlayermx), ZDP(NDLO2,nlayermx)
+      REAL ZNORM(NDLO2),zpsi(NDLO2),zb(NDLO2),zc(NDLO2),
+     *      zulow(NDLO2),zvlow(NDLO2),znup(NDLO2),znum(NDLO2)
+C
+c   declarations pour "implicit none"
+      integer jk,jl,ilevm1,ilevm2,ilevh
+      real zu,zphi,zcons1,zcons2,zcons3,zwind,zdwind,zhgeo
+      real zvt1,zvt2,zst,zvar,zdelp,zstabm,zstabp,zrhom,zrhop
+      real alpha,zggeenv,zggeom1,zgvar
+      logical lo
+
+C     ------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+c     print *,' entree gwsetup'
+ 100  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         1.1   COMPUTATIONAL CONSTANTS
+C                -----------------------
+C
+
+      kidia=1
+	  kfdia=klon
+
+ 110  CONTINUE
+C
+      ILEVM1=KLEV-1
+      ILEVM2=KLEV-2
+      ILEVH =KLEV/3
+C
+      ZCONS1=1./r
+cold  ZCONS2=G**2/CPD
+      ZCONS2=g**2/cpp
+cold  ZCONS3=1.5*API
+      ZCONS3=1.5*PI
+C
+C
+C     ------------------------------------------------------------------
+C
+C*         2.
+C                --------------
+C
+ 200  CONTINUE
+C
+C     ------------------------------------------------------------------
+C
+C*         2.1     DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
+C*                 LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
+C*                 THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
+C
+C
+C
+      DO 2001 JL=kidia,kfdia
+      kknu(JL)    =klev
+      kknu2(JL)   =klev
+      kknub(JL)   =klev
+      kknul(JL)   =klev
+      pgamma(JL) =max(pgamma(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 CONTINUE
+C
+C*      DEFINE TOP OF LOW LEVEL FLOW
+C       ----------------------------
+      DO 2002 JK=KLEV,ilevh,-1
+      DO 2003 JL=kidia,kfdia
+      LO=(PAPHM1(JL,JK)/PAPHM1(JL,KLEV+1)).GE.GSIGCR
+      IF(LO) THEN
+        KKCRIT(JL)=JK
+      ENDIF
+      ZHCRIT(JL,JK)=4.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu(JL)=JK
+      ENDIF
+ 2003 CONTINUE
+ 2002 CONTINUE
+      DO 2004 JK=KLEV,ilevh,-1
+      DO 2005 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=3.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknu2(JL)=JK
+      ENDIF
+ 2005 CONTINUE
+ 2004 CONTINUE
+      DO 2006 JK=KLEV,ilevh,-1
+      DO 2007 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=2.*pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknub(JL)=JK
+      ENDIF
+ 2007 CONTINUE
+ 2006 CONTINUE
+      DO 2008 JK=KLEV,ilevh,-1
+      DO 2009 JL=kidia,kfdia
+      ZHCRIT(JL,JK)=pvaror(JL)
+      ZHGEO=PGEOM1(JL,JK)/g
+      ll1(JL,JK)=(ZHGEO.GT.ZHCRIT(JL,JK))
+      IF(ll1(JL,JK).NEQV.ll1(JL,JK+1)) THEN
+        kknul(JL)=JK
+      ENDIF
+ 2009 CONTINUE
+ 2008 CONTINUE
+C
+      do 2010 jl=kidia,kfdia  
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      if(kknub(jl).eq.nktopg) kknul(jl)=klev
+C
+C     CHANGE IN HERE TO STOP KKNUL=KKNUB
+C
+      if(kknul(jl).le.kknub(jl)) kknul(jl)=nktopg
+ 2010 continue      
+C
+
+ 210  CONTINUE
+C
+C
+CC*     INITIALIZE VARIOUS ARRAYS
+C
+      DO 2107 JL=kidia,kfdia
+      PRHO(JL,KLEV+1)  =0.0
+      PSTAB(JL,KLEV+1) =0.0
+      PSTAB(JL,1)      =0.0
+      PRI(JL,KLEV+1)   =9999.0
+      ppsi(JL,KLEV+1)  =0.0
+      PRI(JL,1)        =0.0
+      PVPH(JL,1)       =0.0
+      PULOW(JL)        =0.0
+      PVLOW(JL)        =0.0
+      zulow(JL)        =0.0
+      zvlow(JL)        =0.0
+      KKCRITH(JL)      =KLEV
+      KKenvH(JL)       =KLEV
+      Kentp(JL)        =KLEV
+      KCRIT(JL)        =1
+      ncount(JL)       =0
+      ll1(JL,klev+1)   =.false.
+ 2107 CONTINUE
+C
+C*     DEFINE LOW-LEVEL FLOW
+C      ---------------------
+C
+      DO 223 JK=KLEV,2,-1
+      DO 222 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PRHO(JL,JK)=2.*PAPHM1(JL,JK)*ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+        PSTAB(JL,JK)=2.*ZCONS2/(PTM1(JL,JK)+PTM1(JL,JK-1))*
+     *  (1.-cpp*PRHO(JL,JK)*(PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+        PSTAB(JL,JK)=MAX(PSTAB(JL,JK),GSSEC)
+      ENDIF
+  222 CONTINUE
+  223 CONTINUE
+C
+C********************************************************************
+C
+C*     DEFINE blocked FLOW
+C      -------------------
+      DO 2115 JK=klev,ilevh,-1
+      DO 2116 JL=kidia,kfdia
+      if(jk.ge.kknub(jl).and.jk.le.kknul(jl)) then
+        pulow(JL)=pulow(JL)+PUM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+        pvlow(JL)=pvlow(JL)+PVM1(JL,JK)*(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))
+      end if
+ 2116 CONTINUE
+ 2115 CONTINUE
+      DO 2110 JL=kidia,kfdia
+      pulow(JL)=pulow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      pvlow(JL)=pvlow(JL)/(PAPHM1(JL,Kknul(jl)+1)-PAPHM1(JL,kknub(jl)))
+      ZNORM(JL)=MAX(SQRT(PULOW(JL)**2+PVLOW(JL)**2),GVSEC)
+      PVPH(JL,KLEV+1)=ZNORM(JL)
+ 2110 CONTINUE
+C
+C*******  SETUP OROGRAPHY AXES AND DEFINE PLANE OF PROFILES  *******
+C
+      DO 2112 JL=kidia,kfdia
+      LO=(PULOW(JL).LT.GVSEC).AND.(PULOW(JL).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PULOW(JL)+2.*GVSEC
+      ELSE
+        ZU=PULOW(JL)
+      ENDIF
+      Zphi=ATAN(PVLOW(JL)/ZU)
+      ppsi(jl,klev+1)=ptheta(jl)*pi/180.-zphi
+      zb(jl)=1.-0.18*pgamma(jl)-0.04*pgamma(jl)**2
+      zc(jl)=0.48*pgamma(jl)+0.3*pgamma(jl)**2
+      pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+      pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))*cos(ppsi(jl,klev+1))
+      pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+ 2112 CONTINUE
+C
+C  ************ DEFINE FLOW IN PLANE OF LOWLEVEL STRESS *************
+C
+      DO 213 JK=1,KLEV
+      DO 212 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1)  THEN
+        ZVt1       =PULOW(JL)*PUM1(JL,JK)+PVLOW(JL)*PVM1(JL,JK)
+        ZVt2       =-PvLOW(JL)*PUM1(JL,JK)+PuLOW(JL)*PVM1(JL,JK)
+        ZVPF(JL,JK)=(zvt1*pd1(jl)+zvt2*pd2(JL))/(znorm(jl)*pdmod(jl))
+      ENDIF
+      PTAU(JL,JK)  =0.0
+      Pzdep(JL,JK) =0.0
+      Ppsi(JL,JK)  =0.0
+      ll1(JL,JK)   =.FALSE.
+  212 CONTINUE
+  213 CONTINUE
+      DO 215 JK=2,KLEV
+      DO 214 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDP(JL,JK)=PAPM1(JL,JK)-PAPM1(JL,JK-1)
+        PVPH(JL,JK)=((PAPHM1(JL,JK)-PAPM1(JL,JK-1))*ZVPF(JL,JK)+
+     *            (PAPM1(JL,JK)-PAPHM1(JL,JK))*ZVPF(JL,JK-1))
+     *            /ZDP(JL,JK)
+        IF(PVPH(JL,JK).LT.GVSEC) THEN
+          PVPH(JL,JK)=GVSEC
+          KCRIT(JL)=JK
+        ENDIF
+      ENDIF
+  214 CONTINUE
+  215 CONTINUE
+C
+C
+C*         2.2     BRUNT-VAISALA FREQUENCY AND DENSITY AT HALF LEVELS.
+C
+  220 CONTINUE
+C
+      DO 2211 JK=ilevh,KLEV
+      DO 221 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+      IF(jk.ge.(kknub(jl)+1).and.jk.le.kknul(jl)) THEN
+           ZST=ZCONS2/PTM1(JL,JK)*(1.-cpp*PRHO(JL,JK)*
+     *                   (PTM1(JL,JK)-PTM1(JL,JK-1))/ZDP(JL,JK))
+           PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)+ZST*ZDP(JL,JK)
+           PSTAB(JL,KLEV+1)=MAX(PSTAB(JL,KLEV+1),GSSEC)
+           PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)+PAPHM1(JL,JK)*2.*ZDP(JL,JK)
+     *                   *ZCONS1/(PTM1(JL,JK)+PTM1(JL,JK-1))
+      ENDIF
+      ENDIF
+  221 CONTINUE
+ 2211 CONTINUE
+C
+      DO 2212 JL=kidia,kfdia
+C*****************************************************************************
+C
+C     O.K. THERE IS A POSSIBLE PROBLEM HERE. IF KKNUL=KKNUB THEN
+C     DIVISION BY ZERO OCCURS. I HAVE PUT A FIX IN HERE BUT WILL ASK FRANCOIS 
+C     LOTT ABOUT IT IN PARIS.
+C
+C     MAT COLLINS 30.1.96
+C
+C     ALSO IF THIS IS THE CASE PSTAB AND PRHO ARE NOT DEFINED AT KLEV+1
+C     SO I HAVE ADDED THE ELSE
+C
+C*****************************************************************************
+      IF (KKNUL(JL).NE.KKNUB(JL)) THEN
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV+1)/(PAPM1(JL,Kknul(jl))
+     *                                          -PAPM1(JL,kknub(jl)))
+      ELSE
+      WRITE(*,*) 'OROSETUP: KKNUB=KKNUL= ',KKNUB(JL),' AT JL= ',JL
+        PSTAB(JL,KLEV+1)=PSTAB(JL,KLEV)
+        PRHO(JL,KLEV+1)=PRHO(JL,KLEV)
+      ENDIF
+        ZVAR=PVARor(JL)
+ 2212 CONTINUE
+C
+C*         2.3     MEAN FLOW RICHARDSON NUMBER.
+C*                 AND CRITICAL HEIGHT FOR FROUDE LAYER
+C
+  230 CONTINUE
+C
+      DO 232 JK=2,KLEV
+      DO 231 JL=kidia,kfdia
+      IF(KTEST(JL).EQ.1) THEN
+        ZDWIND=MAX(ABS(ZVPF(JL,JK)-ZVPF(JL,JK-1)),GVSEC)
+        PRI(JL,JK)=PSTAB(JL,JK)*(ZDP(JL,JK)
+     *          /(g*PRHO(JL,JK)*ZDWIND))**2
+        PRI(JL,JK)=MAX(PRI(JL,JK),GRCRIT)
+      ENDIF
+  231 CONTINUE
+  232 CONTINUE
+C
+C
+C*      DEFINE TOP OF 'envelope' layer
+C       ----------------------------
+
+      DO 233 JL=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  CONTINUE
+      
+      DO 234 JK=2,KLEV-1
+      DO 234 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+       
+      IF (JK.GE.KKNU2(JL)) THEN
+          
+            ZNUM(JL)=PNU(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            PNU(JL) = PNU(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.GFRCRIT).AND.(PNU(JL).GT.GFRCRIT)
+     *                          .AND.(KKENVH(JL).EQ.KLEV))
+     *      KKENVH(JL)=JK
+     
+      ENDIF    
+
+      ENDIF
+      
+ 234  CONTINUE
+
+C  CALCULATION OF A DYNAMICAL MIXING HEIGHT FOR THE BREAKING
+C  OF GRAVITY WAVES:
+
+              
+      DO 235 JL=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  CONTINUE
+
+      DO 236 JK=KLEV-1,2,-1
+      DO 236 JL=kidia,kfdia
+      
+      IF(KTEST(JL).EQ.1) THEN
+        
+      IF (JK.LT.KKENVH(JL)) THEN
+
+            ZNUM(JL)=ZNUP(JL)
+            ZWIND=(pulow(JL)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            ZWIND=max(sqrt(zwind**2),gvsec)
+            ZDELP=PAPHM1(JL,JK+1)-PAPHM1(JL,JK)
+            ZSTABM=SQRT(MAX(PSTAB(JL,JK  ),GSSEC))
+            ZSTABP=SQRT(MAX(PSTAB(JL,JK+1),GSSEC))
+            ZRHOM=PRHO(JL,JK  )
+            ZRHOP=PRHO(JL,JK+1)
+            ZNUP(JL) = ZNUP(JL) + (ZDELP/g)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/ZWIND     
+            IF((ZNUM(JL).LE.1.5).AND.(ZNUP(JL).GT.1.5)
+     *                          .AND.(KKCRITH(JL).EQ.KLEV))
+     *      KKCRITH(JL)=JK
+     
+      ENDIF
+      
+      ENDIF
+      
+ 236  CONTINUE
+ 
+      DO 237 JL=KIDIA,KFDIA
+      KKCRITH(JL)=MIN0(KKCRITH(JL),KKNU(JL))
+ 237  CONTINUE
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=ilevh,klev    
+      DO 252 JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+      LO=(PUm1(JL,jk).LT.GVSEC).AND.(PUm1(JL,jk).GE.-GVSEC)
+      IF(LO) THEN
+        ZU=PUm1(JL,jk)+2.*GVSEC
+      ELSE
+        ZU=PUm1(JL,jk)
+      ENDIF
+       Zphi=ATAN(PVm1(JL,jk)/ZU)
+       ppsi(jl,jk)=ptheta(jl)*pi/180.-zphi
+      end if
+ 252  continue
+ 251  CONTINUE
+c      forms the vertical 'leakiness' **************************
+
+      alpha=3.
+      
+      DO 254  JK=ilevh,klev
+      DO 253  JL=kidia,kfdia
+      IF(jk.ge.kkenvh(jl)) THEN
+        zggeenv=AMAX1(1.,
+     *          (pgeom1(jl,kkenvh(jl))+pgeom1(jl,kkenvh(jl)-1))/2.)      
+        zggeom1=AMAX1(pgeom1(jl,jk),1.)
+        zgvar=amax1(pvaror(jl)*g,1.)     
+        pzdep(jl,jk)=SQRT((zggeenv-zggeom1)/(zggeom1+zgvar))      
+      end if
+ 253  CONTINUE
+ 254  CONTINUE
+
+ 260  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/physdem1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/physdem1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/physdem1.F	(revision 46)
@@ -0,0 +1,657 @@
+      subroutine physdem1(filename,lonfi,latfi,nsoil,nq,
+     .                   phystep,day_ini,
+     .                   time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .                   airefi,alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
+
+      implicit none
+c-------------------------------------------------------------
+c
+c create physics (re-)start data file "restartfi.nc"
+c
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+c-----------------------------------------------------------------------
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "comdissnew.h"
+#include "logic.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "dimphys.h"
+#include"advtrac.h"
+#include"callkeys.h"
+c
+      INTEGER nid,iq
+      INTEGER, parameter :: ivap=1
+      REAL, parameter :: qsolmax= 150.0
+      character (len=*) :: filename
+      character (len=7) :: str7
+
+      REAL day_ini
+      INTEGER nsoil,nq
+      integer ierr,idim1,idim2,idim3,idim4,idim5,nvarid
+
+c
+      REAL phystep,time
+      REAL latfi(ngridmx), lonfi(ngridmx)
+!      REAL champhys(ngridmx)
+      REAL tsurf(ngridmx)
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length)
+
+c
+
+!      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
+!      EXTERNAL exner_hyb , SSUM
+c
+#include "serre.h"
+#include "clesph0.h"
+#include "fxyprim.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+
+      real co2ice(ngridmx),tsoil(ngridmx,nsoil),emis(ngridmx)
+      real q2(ngridmx, llm+1),qsurf(ngridmx,nq)
+      real airefi(ngridmx)
+      real alb(ngridmx),ith(ngridmx,nsoil)
+      real pzmea(ngridmx),pzstd(ngridmx)
+      real pzsig(ngridmx),pzgam(ngridmx),pzthe(ngridmx)
+      integer ig
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+! flag which identifies if we are using old tracer names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+! indexes of water vapour & water ice tracers (if any):
+      integer :: i_h2o_vap=0
+      integer :: i_h2o_ice=0
+c-----------------------------------------------------------------------
+
+      ! copy airefi(:) to area(:)
+      CALL SCOPY(ngridmx,airefi,1,area,1)
+      ! note: area() is defined in comgeomfi.h
+
+      DO ig=1,ngridmx
+         albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat.h
+         zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat.h
+         zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat.h
+         zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat.h
+         zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat.h
+         zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat.h
+      ENDDO
+
+      inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil.h
+c
+c  things to store in the physics start file:
+c
+      ierr = NF_CREATE(adjustl(filename),NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        WRITE(6,*)'physdem1: Problem creating file ',adjustl(filename)
+        write(6,*) NF_STRERROR(ierr)
+        CALL ABORT
+      ENDIF
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
+     .                       "Physics start file")
+c
+      ierr = NF_DEF_DIM (nid,"index",length,idim1)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining index dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"physical_points",ngridmx,idim2)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining physical_points dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
+      if (ierr.ne.NF_NOERR) then
+      WRITE(6,*)'physdem1: Problem defining subsurface_layers dimension'
+	write(6,*) NF_STRERROR(ierr)
+        call abort
+      endif
+c
+!      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
+      ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining nlayer+1 dimension'
+        write(6,*) NF_STRERROR(ierr)
+	call abort
+      endif
+c
+      ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
+      if (ierr.ne.NF_NOERR) then
+        WRITE(6,*)'physdem1: Problem defining advected fields dimension'
+        WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
+        write(6,*) NF_STRERROR(ierr)
+      endif
+
+      ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
+
+c clear tab_cntrl(:) array
+      DO ierr = 1, length
+         tab_cntrl(ierr) = 0.0
+      ENDDO
+
+      write(*,*) "physdem1: ngridmx: ",ngridmx
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Fill control array tab_cntrl(:) with paramleters for this run
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c Informations on the physics grid
+      tab_cntrl(1) = float(ngridmx)  ! number of nodes on physics grid
+      tab_cntrl(2) = float(nlayermx) ! number of atmospheric layers
+      tab_cntrl(3) = day_ini + int(time)         ! initial day 
+      tab_cntrl(4) = time -int(time)            ! initiale time of day
+
+c Informations about Mars, used by dynamics and physics
+      tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
+      tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
+      tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
+      tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
+      tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
+      tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
+
+      tab_cntrl(11) = phystep  ! time step in the physics
+      tab_cntrl(12) = 0.
+      tab_cntrl(13) = 0.
+
+c Informations about Mars, only for physics
+      tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
+      tab_cntrl(15) = periheli  ! min. Sun-Mars distance (Mkm) ~206.66
+      tab_cntrl(16) = aphelie   ! max. SUn-Mars distance (Mkm) ~249.22
+      tab_cntrl(17) = peri_day  ! date of perihelion (sols since N. spring)
+      tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
+
+c Boundary layer and turbulence
+      tab_cntrl(19) = z0        ! surface roughness (m) ~0.01
+      tab_cntrl(20) = lmixmin   ! mixing length ~100
+      tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
+
+c Optical properties of polar caps and ground emissivity
+      tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
+      tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
+      tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
+      tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
+      tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
+      tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
+      tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
+      tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
+      tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
+
+c dust aerosol properties
+      tab_cntrl(27) = tauvis      ! mean visible optical depth
+
+      tab_cntrl(28) = 0. 
+      tab_cntrl(29) = 0.
+      tab_cntrl(30) = 0.
+
+! Soil properties:
+      tab_cntrl(35) = volcapa ! soil volumetric heat capacity
+      
+c
+!      write(*,*) "physdem1: tab_cntrl():",tab_cntrl
+      
+      ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+         CALL abort
+      ENDIF
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to define controle'
+         CALL abort
+      ENDIF
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                        "Control parameters")
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to define controle title attribute'
+         CALL abort
+      ENDIF
+      ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to swich out of NetCDF define mode'
+         CALL abort
+      ENDIF
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'physdem1: Failed to write controle data'
+         CALL abort
+      ENDIF
+
+! write mid-layer depths mlayer() !known from comsoil.h
+
+      ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"soildepth",NF_DOUBLE,1,idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"soildepth",NF_FLOAT,1,idim3,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+     .                        "Soil mid-layer depth")
+      ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
+     .                        "Longitudes of physics grid")
+      ierr = NF_ENDDEF(nid)
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
+     .                        "Latitudes of physics grid")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                        "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .                        "Geopotential at the surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
+#endif
+
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 21,
+     .                        "Albedo of bare ground")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
+#endif
+
+c
+c   some data for Francois Lott's programs
+c
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Relief: mean relief")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
+     .                        "Relief: standard deviation")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: sigma parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: gamma parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                        "Relief: theta parameter")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
+#endif
+
+c Write the physical fields
+
+! CO2 Ice Cover
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
+     .                        "CO2 ice cover")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,co2ice)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,co2ice)
+#endif
+
+! Soil Thermal inertia
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"inertiedat",NF_DOUBLE,
+     &                   2,(/idim2,idim3/),nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"inertiedat",NF_FLOAT,
+     &                   2,(/idim2,idim3/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 20,
+     .                        "Soil thermal inertia")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
+#endif
+
+!  Surface temperature
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                        "Surface temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsurf)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsurf)
+#endif
+
+! Soil temperature
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_DOUBLE,2,(/idim2,idim3/),nvarid)
+#else
+!      ierr = NF_DEF_VAR (nid, "tsoil", NF_FLOAT, 2, idim2,nvarid)
+      ierr = NF_DEF_VAR (nid,"tsoil",NF_FLOAT,2,(/idim2,idim3/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
+     .                        "Soil temperature")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil)
+#endif
+
+c emissivity
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "emis", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
+     .                        "Surface emissivity")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,emis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,emis)
+#endif
+
+c planetary boundary layer
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 2, (/idim2,idim4/),nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 2,(/idim2,idim4/),nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     .                        "pbl wind variance")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q2)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,q2)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+        PRINT*, 'physdem1: Failed to write q2'
+        CALL abort
+      ENDIF
+
+c tracers
+
+! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+!                    qsurf02, ...)
+      count=0
+      do iq=1,nqmx
+        txt= " "
+        write(txt,'(a1,i2.2)')'q',iq
+        if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          count=count+1
+        endif
+      enddo
+      if (count.eq.nqmx) then
+        write(*,*) "physdem1:tracers seem to follow old naming ",
+     &             "convention (qsurf01,qsurf02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldtracernames=.true.
+        ! Moreover, if computing water cycle with ice, move surface ice
+        ! back to qsurf(nqmx)
+        IF (water) THEN
+          write(*,*)'physdem1: moving surface water ice to index ',nqmx
+          qsurf(1:ngridmx,nqmx)=qsurf(1:ngridmx,nqmx-1)
+          qsurf(1:ngridmx,nqmx-1)=0
+        ENDIF
+      endif ! of if (count.eq.nqmx)
+
+      IF(nq.GE.1) THEN
+! preliminary stuff: look for water vapour & water ice tracers (if any)
+        if (.not.oldtracernames) then
+         do iq=1,nq
+           if (tnom(iq).eq."h2o_vap") then
+             i_h2o_vap=iq
+           endif
+           if (tnom(iq).eq."h2o_ice") then
+             i_h2o_ice=iq
+           endif
+         enddo ! of iq=1,nq
+         ! handle special case of only water vapour tracer (no ice)
+         if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
+          ! then the index of (surface) ice is i_h2o_vap
+          i_h2o_ice=i_h2o_vap
+         endif
+        endif ! of if (.not.oldtracernames) 
+
+         DO iq=1,nq
+           IF (oldtracernames) THEN
+             txt=" "
+             write(txt,'(a5,i2.2)')'qsurf',iq
+           ELSE
+             txt=tnom(iq)
+             ! Exception: there is no water vapour surface tracer
+             if (txt.eq."h2o_vap") then
+               write(*,*)"physdem1: skipping water vapour tracer"
+               if (i_h2o_ice.eq.i_h2o_vap) then
+               ! then there is no "water ice" tracer; but still
+               ! there is some water ice on the surface
+                 write(*,*)"          writting water ice instead"
+                 txt="h2o_ice"
+               else
+               ! there is a "water ice" tracer which has been / will be
+               ! delt with in due time
+                 cycle
+               endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
+             endif ! of if (txt.eq."h2o_vap")
+           ENDIF ! of IF (oldtracernames)
+
+           ierr=NF_REDEF(nid)
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to swich to NetCDF define mode'
+             CALL abort
+           ENDIF
+#ifdef NC_DOUBLE
+           ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,1,idim2,nvarid)
+#else
+           ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,1,idim2,nvarid)
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to define ',trim(txt)
+             CALL abort
+           ENDIF
+           ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
+     &                        "tracer on surface")
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to define ',trim(txt),
+     &               ' title attribute'
+             CALL abort
+           ENDIF
+           ierr=NF_ENDDEF(nid)
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to swich out of define mode'
+             CALL abort
+           ENDIF
+           
+#ifdef NC_DOUBLE
+            ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,iq))
+#else
+            ierr=NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,iq))
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, 'physdem1: Failed to write ',trim(txt)
+             CALL abort
+           ENDIF
+         ENDDO ! of DO iq=1,nq
+      ENDIF ! of IF(nq.GE.1)
+
+c close file
+      ierr = NF_CLOSE(nid)
+
+      RETURN
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/sugwd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/sugwd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/nocompile/sugwd.F	(revision 46)
@@ -0,0 +1,109 @@
+      SUBROUTINE SUGWD(NLEV,PSIG)
+C     
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C     GRAVITY WAVE DRAG PARAMETRIZATION.
+C     
+C     EXPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     INPUT :
+C     
+C     PSIG        : VERTICAL COORDINATE TABLE
+C     NLEV        : NUMBER OF MODEL LEVELS
+C     
+C     OUTPUT :
+C     
+C     NONE
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     COMMON YOEGWD
+C     
+C     METHOD.
+C     -------
+C     SEE DOCUMENTATION
+C     
+C     EXTERNALS.
+C     ----------
+C     NONE
+C     
+C     REFERENCE.
+C     ----------
+C     ECMWF Research Department documentation of the IFS
+C     
+C     AUTHOR.
+C     -------
+C     MARTIN MILLER             *ECMWF*
+C     
+C     MODIFICATIONS.
+C     --------------
+C     ORIGINAL : 90-01-01
+C     ------------------------------------------------------------------
+      implicit none
+C     
+C     -----------------------------------------------------------------
+c     !-*-      include 'yoegwd.h'
+#include "yoegwd.h"
+c     !-*-
+C     ----------------------------------------------------------------
+C     
+      integer nlev
+      REAL PSIG(NLEV+1)
+
+      real zsigt,zpr,zpm1r
+      integer jk
+C     
+C     *       1.    SET THE VALUES OF THE PARAMETERS
+C     --------------------------------
+C     
+ 100  CONTINUE
+C     
+c     PRINT *,' Dans sugwd nlev=',NLEV,' SIG=',PSIG
+      GHMAX=10000.
+C     
+c     old  ZSIGT=0.94
+c     old  ZPR=80000.
+      ZSIGT=0.85
+      ZPR=100000.
+C     
+      DO 110 JK=1,NLEV-1
+         ZPM1R=0.5*ZPR*(PSIG(JK)+PSIG(JK+1))
+         IF((ZPM1R/ZPR).GE.ZSIGT)THEN
+            NKTOPG=JK
+         ENDIF
+ 110  CONTINUE
+      WRITE(*,*) 'In sugwd NKTOPG=',NKTOPG
+C     
+      GSIGCR=0.80
+C     
+      GKDRAG= 0.1  ! used to be 0.1 for mcd Version 1 and 2 (before 10/2000)
+      GRCRIT=0.25
+      GFRCRIT=1.0
+      GKWAKE=1.0
+
+C     
+      GKDRAGL=4.*GKDRAG
+      GRAHILO=1.
+      GVCRIT =0.0
+C     
+C     
+C     ----------------------------------------------------------------
+C     
+C     *       2.    SET VALUES OF SECURITY PARAMETERS
+C     ---------------------------------
+C     
+ 200  CONTINUE
+C     
+      GVSEC=0.10
+      GSSEC=1.E-12
+C     
+      GTSEC=1.E-07
+C     
+C     ----------------------------------------------------------------
+C     
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/orbite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/orbite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/orbite.F	(revision 46)
@@ -0,0 +1,63 @@
+      SUBROUTINE orbite(pls,pdist_sol,pdecli)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c   Distance from sun and declimation as a function of the solar
+c   longitude Ls
+c
+c   Interface:
+c   ----------
+c
+c
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pls          Ls
+c
+c   Output:
+c   -------
+c   pdist_sol     Distance Sun-Planet in UA
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,pls,i
+
+c-----------------------------------------------------------------------
+
+c Distance Sun-Planet
+
+      pdist_sol=p_elips/(1.+e_elips*cos(pls+timeperi))
+
+c Solar declination
+
+c ********************* version before 01/01/2000 *******
+
+      pdecli= asin (sin(pls)*sin(obliquit*pi/180.))
+
+c ********************* version after 01/01/2000 *******
+c     i=obliquit*pi/180.
+c     pdecli=asin(sin(pls)*sin(i)/sqrt(sin(pls)**2+
+c    & cos(pls)**2*cos(i)**2))
+c ******************************************************
+
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope.F90	(revision 46)
@@ -0,0 +1,220 @@
+SUBROUTINE 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 param_slope
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope_full.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope_full.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/param_slope_full.F90	(revision 46)
@@ -0,0 +1,248 @@
+SUBROUTINE param_slope_full( &
+  !
+  ! INPUTS
+  !
+               &  ls, localtime, latitude, taudust, albedo  &
+               &  ,theta_s, psi_s &
+               &  ,ftot_0  &
+  !
+  ! OUTPUTS
+  !
+               &  ,ftot &
+ )
+
+
+!!*****************************************************************************************
+!
+! SUBROUTINE:
+! param_slope
+! 
+!
+! PURPOSE: 
+! computes total solar irradiance on a given Martian slope 
+!
+!
+! INPUTS:
+! ls	 	aerocentric longitude (deg)
+! localtime	local true solar time (Martian hours)
+! 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)
+!
+!
+! 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) :: ls, localtime, latitude, taudust, theta_s, psi_s, albedo, ftot_0  
+
+!!
+!! LOCAL
+!!
+REAL :: pi, deg2rad, dist_sol, cste_mars
+REAL, PARAMETER :: p = 1.510404          ! Semi-latus rectum of Martian elliptic orbit (AU)
+REAL, PARAMETER :: e = 9.3357898E-02     ! Eccentricity of Martian elliptic orbit
+REAL, PARAMETER :: t = 1.908231          ! Angle from Ls=0 to the perihelion (radian)
+REAL, PARAMETER :: so = 0.4256214        ! sin(Obliquity of Martian axis) 
+REAL :: rho, sdec, dec, cdec, csza, sza, ssza, psi0 
+REAL :: px, py
+REAL :: a
+REAL :: mu_s, sigma_s
+REAL :: fdir, fdir_0, 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
+
+!
+! Sun right ascension (radian)
+!
+  rho = pi*(1.0-localtime/12.0)
+
+!
+! Distance to sun (AU)
+!
+  dist_sol = p/(1.0+e*cos(deg2rad*Ls+t))   !! ellipse polar equation 
+ 
+!
+! Incident flux @ top of the atmosphere (Mars solar constant, W m-2)
+!
+  cste_mars=1370./(dist_sol*dist_sol)      !! 1370 W.m-2 is the solar constant at 1 AU.
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! pour comparer avec spectres ESA
+!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!cste_mars=cste_mars*0.92
+
+
+!
+! Sun declination (radian) [= subsolar point latitude]
+!
+  sdec = sin(deg2rad*Ls)*so
+  dec = asin(sdec)  
+  cdec = cos(dec)
+
+!
+! Solar Zenith angle (radian) 
+!
+  csza = sin(deg2rad*latitude)*sdec + cos(deg2rad*latitude)*cdec*cos(rho)
+  sza = acos(csza)
+  ssza = sin(sza)
+  if (csza < 0.01) then
+      !print *, 'sun below horizon' 
+      fdir_0=0.
+      fdir=0.
+      fscat_0=0.
+      fscat=0.   
+      fref=0.
+  else      
+
+!
+! 'Slope vs Sun' azimuth (radian)
+!
+  if ( ( (cdec*sin(rho)) .eq. 0.0 ) .and. ( ( sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec ) .eq. 0.0 ) ) then
+    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
+  else
+    a = deg2rad*psi_s + atan2(cdec*sin(rho),sin(deg2rad*latitude)*cdec*cos(rho)-cos(deg2rad*latitude)*sdec)
+  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 a flat surface
+!
+  fdir_0 = cste_mars*csza*exp(-taudust/csza)
+
+!
+! 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 *, 'scattered component ', fscat
+!  print *, 'direct component ', fdir
+!  print *, 'reflected component ', fref
+
+END SUBROUTINE param_slope_full
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/phyetat0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/phyetat0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/phyetat0.F	(revision 46)
@@ -0,0 +1,594 @@
+      SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,nq,
+     .           day_ini,time,
+     .           tsurf,tsoil,emis,q2,qsurf,co2ice)
+      implicit none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "planete.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "comcstfi.h"
+!#include "tracer.h"
+#include"advtrac.h"
+c======================================================================
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+!======================================================================
+!  Arguments:
+!  ---------
+!  inputs:
+      character*(*) fichnom ! "startfi.nc" file
+      integer tab0
+      integer Lmodif
+      integer nsoil ! # of soil layers
+      integer nq
+      integer day_ini
+      real time
+
+!  outputs:
+      real tsurf(ngridmx,nbsrf) ! surface temperature
+      real tsoil(ngridmx,nsoil,nbsrf) ! soil temperature
+      real emis(ngridmx) ! surface emissivity
+      real q2(ngridmx, llm+1) ! 
+      real qsurf(ngridmx,nq) ! tracers on surface
+      real co2ice(ngridmx) ! co2 ice cover
+
+!======================================================================
+!  Local variables:
+
+!      INTEGER radpas
+!      REAL co2_ppm
+!      REAL solaire
+
+      real xmin,xmax ! to display min and max of a field
+c
+      INTEGER ig,iq,lmax
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf
+!      integer isoil 
+!      INTEGER length
+!      PARAMETER (length=100)
+      CHARACTER*7 str7
+      CHARACTER*2 str2
+      CHARACTER*1 yes
+c
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+      INTEGER nqold
+
+! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+
+ 
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+
+! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
+!                    qsurf02, ...)
+      count=0
+      do iq=1,nqmx
+        txt= " "
+        write(txt,'(a5,i2.2)')'qsurf',iq
+        ierr=NF_INQ_VARID(nid,txt,nvarid)
+        if (ierr.ne.NF_NOERR) then
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          count=count+1
+        endif
+      enddo
+      if (count.eq.nqmx) then
+        write(*,*) "phyetat0:tracers seem to follow old naming ",
+     &             "convention (qsurf01,qsurf02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldtracernames=.true.
+      endif
+
+c modifications possibles des variables de tab_cntrl
+      PRINT*
+      write(*,*) 'TABFI de phyeta0',Lmodif,tab0
+      call tabfi (nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .              p_omeg,p_g,p_mugaz,p_daysec,time)
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lati)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, lati)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, long)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, long)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "area", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <area> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, area)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, area)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <area>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(area)
+      xmax = MAXVAL(area)
+      PRINT*,'Aires des mailles <area>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisfi", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <phisfi> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisfi)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisfi)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(phisfi)
+      xmax = MAXVAL(phisfi)
+      PRINT*,'Geopotentiel au sol <phisfi>:', xmin, xmax
+c
+c Lecture de l''albedo du sol nu:
+c
+      ierr = NF_INQ_VARID (nid, "albedodat", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <albedodat> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albedodat)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, albedodat)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(albedodat)
+      xmax = MAXVAL(albedodat)
+      PRINT*,'Albedo du sol nu <albedodat>:', xmin, xmax
+c
+c Lecture de l''inertie thermique du sol:
+c
+!      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
+!#else
+!      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
+!#endif
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
+!         CALL abort
+!      ENDIF
+!      xmin = 1.0E+20
+!      xmax = -1.0E+20
+!      xmin = MINVAL(inertiedat)
+!      xmax = MAXVAL(inertiedat)
+!      PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
+c
+c ZMEA
+c
+      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zmea(i),xmin)
+         xmax = MAX(zmea(i),xmax)
+      ENDDO
+      PRINT*,'<zmea>:', xmin, xmax
+c
+c ZSTD
+c
+      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zstd(i),xmin)
+         xmax = MAX(zstd(i),xmax)
+      ENDDO
+      PRINT*,'<zstd>:', xmin, xmax
+c
+c ZSIG
+c
+      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zsig(i),xmin)
+         xmax = MAX(zsig(i),xmax)
+      ENDDO
+      PRINT*,'<zsig>:', xmin, xmax
+c
+c ZGAM
+c
+      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zgam(i),xmin)
+         xmax = MAX(zgam(i),xmax)
+      ENDDO
+      PRINT*,'<zgam>:', xmin, xmax
+c
+c ZTHE
+c
+      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, ngridmx
+         xmin = MIN(zthe(i),xmin)
+         xmax = MAX(zthe(i),xmax)
+      ENDDO
+      PRINT*,'<zthe>:', xmin, xmax
+c
+c CO2 ice cover
+c
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <co2ice> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, co2ice)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, co2ice)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(co2ice)
+      xmax = MAXVAL(co2ice)
+      PRINT*,'CO2 ice cover <co2ice>:', xmin, xmax
+c
+c Lecture des temperatures du sol:
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <tsurf> est absent'
+         PRINT*, '          Mais je vais essayer de lire TS**'
+         IF (nbsrf.GT.99) THEN
+            PRINT*, "Trop de sous-mailles"
+            CALL abort
+         ENDIF
+         DO nsrf = 1, nbsrf
+           WRITE(str2,'(i2.2)') nsrf
+           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
+              CALL abort
+           ENDIF
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,nsrf))
+#else
+           ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,nsrf))
+#endif
+           IF (ierr.NE.NF_NOERR) THEN
+             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
+             CALL abort
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(tsurf)
+           xmax = MAXVAL(tsurf)
+           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
+         ENDDO
+      ELSE
+         PRINT*, 'phyetat0: Le champ <tsurf> est present'
+         PRINT*, '          J ignore donc les autres temperatures TS**'
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsurf(1,1))
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, tsurf(1,1))
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
+            CALL abort
+         ENDIF
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         xmin = MINVAL(tsurf)
+         xmax = MAXVAL(tsurf)
+         PRINT*,'Temperature du sol <tsurf>', xmin, xmax
+         IF (nbsrf >= 2) THEN
+            DO nsrf = 2, nbsrf
+               DO i = 1, ngridmx
+                  tsurf(i,nsrf) = tsurf(i,1)
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+c
+c Lecture des temperatures du sol profond:
+c
+!      IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
+!         PRINT*, "Trop de couches ou sous-mailles"
+!         CALL abort
+!      ENDIF
+!      DO nsrf = 1, nbsrf
+!         DO isoil=1, nsoil
+!            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
+!            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
+!            IF (ierr.NE.NF_NOERR) THEN
+!               PRINT*, "phyetat0: Le champ <tsoil> est absent"
+!               PRINT*, "          Il prend donc la valeur de surface"
+!               DO i=1, ngridmx
+!                  tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
+!               ENDDO
+!            ELSE
+!#ifdef NC_DOUBLE
+!              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
+!#else
+!              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
+!#endif
+!               IF (ierr.NE.NF_NOERR) THEN
+!                  PRINT*, "Lecture echouee pour <tsoil>"
+!                  CALL abort
+!               ENDIF
+!            ENDIF
+!         ENDDO
+!      ENDDO
+!      xmin = 1.0E+20
+!      xmax = -1.0E+20
+!      xmin = MINVAL(tsoil)
+!      xmax = MAXVAL(tsoil)
+!      PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
+c
+c Surface emissivity
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <emis> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, emis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, emis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <emis>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(emis)
+      xmax = MAXVAL(emis)
+      PRINT*,'Surface emissivity <emis>:', xmin, xmax
+c
+c pbl wind variance
+c
+      ierr = NF_INQ_VARID (nid, "q2", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Le champ <q2> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q2)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, q2)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'phyetat0: Lecture echouee pour <q2>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(q2)
+      xmax = MAXVAL(q2)
+      PRINT*,'pbl wind variance <q2>:', xmin, xmax
+c
+c tracer on surface
+c
+
+      IF(nq.GE.1) THEN
+         nqold=nq
+         DO iq=1,nq
+!            str7(1:5)='qsurf'
+!            WRITE(str7(6:7),'(i2.2)') iq
+!            ierr = NF_INQ_VARID (nid,str7,nvarid)
+           IF (oldtracernames) THEN
+             txt=" "
+             write(txt,'(a5,i2.2)')'qsurf',iq
+           ELSE
+             txt=tnom(iq)
+             if (txt.eq."h2o_vap") then
+               ! There is no surface tracer for h2o_vap;
+               ! "h2o_ice" should be loaded instead
+               txt="h2o_ice"
+               write(*,*) 'phyetat0: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+             endif
+           ENDIF ! of IF (oldtracernames) THEN
+           ierr=NF_INQ_VARID(nid,txt,nvarid)
+           IF (ierr.NE.NF_NOERR) THEN
+             write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
+     &                  ' not found in file'
+             write(*,*) trim(txt), ' set to 0'
+             do ig=1,ngridmx
+               qsurf(ig,iq)=0.
+             end do
+             nqold=min(iq-1,nqold)
+           ELSE
+#ifdef NC_DOUBLE
+             ierr = NF_GET_VAR_DOUBLE(nid, nvarid,qsurf(1,iq))
+#else
+             ierr = NF_GET_VAR_REAL(nid, nvarid,qsurf(1,iq))
+#endif
+             IF (ierr.NE.NF_NOERR) THEN
+               PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
+               CALL abort
+             ENDIF
+           ENDIF
+           xmin = 1.0E+20
+           xmax = -1.0E+20
+           xmin = MINVAL(qsurf(1:ngridmx,iq))
+           xmax = MAXVAL(qsurf(1:ngridmx,iq))
+           PRINT*,'tracer on surface <',trim(txt),'>:',xmin,xmax
+         ENDDO
+         if ((nqold.lt.nq).and.(nqold.ge.1)) then
+c        case when new tracer are added in addition to old ones
+             write(*,*)'qsurf 1 to ', nqold,'were already present'
+             write(*,*)'qsurf ', nqold+1,' to ', nqmx,'are new'
+            yes=' '
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+             write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
+             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+             read(*,fmt='(a)') yes
+            end do
+            if (yes.eq.'y') then
+              write(*,*) 'OK, let s reindex qsurf'
+                 do ig=1,ngridmx
+                    do iq=nqmx,nqmx-nqold+1,-1
+                       qsurf(ig,iq)=qsurf(ig,iq-nqmx+nqold)
+                    end do
+                    do iq=nqmx-nqold,1,-1
+                       qsurf(ig,iq)= 0.
+                    end do
+                 end do
+            end if
+         end if
+      ENDIF
+
+! Call to soil_settings, in order to read soil temperatures,
+! as well as thermal inertia and volumetric heat capacity
+
+      call soil_settings(nid,ngridmx,nsoil,tsurf,tsoil)
+c
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/planete.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/planete.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/planete.h	(revision 46)
@@ -0,0 +1,14 @@
+c-----------------------------------------------------------------------
+c INCLUDE planet.h
+
+      COMMON/planet/aphelie,periheli,year_day,peri_day,
+     $       obliquit,
+     $       z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+      REAL aphelie,periheli,year_day,peri_day,
+     $     obliquit,
+     $     z0,lmixmin,emin_turb,coefvis,coefir,
+     $       timeperi,e_elips,p_elips,unitastr
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/profile.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/profile.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/profile.F	(revision 46)
@@ -0,0 +1,225 @@
+!      SUBROUTINE profile(unit,nlev,zkm,temp)
+      SUBROUTINE profile(nlev,zkm,temp)
+! to use  'getin'
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+c=======================================================================
+c     Subroutine utilisee dans le modele 1-D  "testphys1d"
+c     pour l'initialisation du profil atmospherique
+c=======================================================================
+c
+c   differents profils d'atmospheres. T=f(z)
+c   entree:
+c     nlev    nombre de niveaux
+c     zkm     alititudes en km
+c     ichoice choix de l'atmosphere:
+c             1 Temperature constante
+c             2 profil Savidjari
+c             3 Lindner (profil polaire)
+c             4 Inversion pour Francois
+c             5 Seiff (moyen)
+c             6 T constante + perturbation gauss (level) (christophe 10/98)
+c             7 T constante + perturbation gauss   (km)  (christophe 10/98)
+c             8 Lecture du profile dans un fichier ASCII (profile)
+c     tref    temperature de reference
+c     isin    ajout d'une perturbation (isin=1)
+c     pic     pic perturbation gauss pour ichoice = 6 ou 7
+c     largeur largeur de la perturbation gauss pour ichoice = 6 ou 7
+c     hauteur hauteur de la perturbation gauss pour ichoice = 6 ou 7
+c
+c   sortie:
+c     temp    temperatures en K
+c     
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+       INTEGER nlev
+       REAL zkm(nlev),temp(nlev)
+
+c   local:
+c   ------
+
+      INTEGER il,ichoice,nseiff,iseiff,isin,iter
+      REAL pi
+      PARAMETER(nseiff=37)
+      REAL tref,t1,t2,t3,ww
+      REAL tseiff(nseiff)
+      DATA tseiff/214.,213.8,213.4,212.4,209.3,205.,201.4,197.8,
+     $           194.6,191.4,188.2,185.2,182.5,180.,177.5,175,
+     $           172.5,170.,167.5,164.8,162.4,160.,158.,156.,
+     $           154.1,152.2,150.3,148.7,147.2,145.7,144.2,143.,
+     $           142.,141.,140,139.5,139./
+      REAL pic,largeur
+      REAL hauteur,tmp
+
+c-----------------------------------------------------------------------
+c   read input profile type:
+c--------------------------
+
+      ichoice=1 ! default value for ichoice
+      call getin("ichoice",ichoice)
+      tref=200 ! default value for tref
+      call getin("tref",tref)
+      isin=0 ! default value for isin (=0 means no perturbation)
+      call getin("isin",isin)
+      pic=26.522 ! default value for pic
+      call getin("pic",pic)
+      largeur=10 ! default value for largeur
+      call getin("largeur",largeur)
+      hauteur=30 ! default value for hauteur
+      call getin("hauteur",hauteur)
+
+c-----------------------------------------------------------------------
+c   ichoice=1 temperature constante:
+c   --------------------------------
+
+      IF(ichoice.EQ.1) THEN
+         DO il=1,nlev
+            temp(il)=tref
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=2 savidjari:
+c   --------------------
+
+      ELSE IF(ichoice.EQ.2) THEN
+         DO il=1,nlev
+            temp(il)=AMAX1(219.-2.5*zkm(il),140.)
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=3 Lindner:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.3) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.2.5) THEN
+               temp(il)=150.+30.*zkm(il)/2.5
+            ELSE IF(zkm(il).LT.5.) THEN
+               temp(il)=180.
+            ELSE
+               temp(il)=AMAX1(180.-2.*(zkm(il)-5.),130.)
+            ENDIF
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=4 Inversion pour Francois:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.4) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.20.) THEN
+               temp(il)=135.
+            ELSE
+               temp(il)=AMIN1(135.+5.*(zkm(il)-20.),200.)
+            ENDIF
+         ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=5 Seiff:
+c   ----------------
+
+      ELSE IF(ichoice.EQ.5) THEN
+	 DO il=1,nlev
+	    iseiff=INT(zkm(il)/2.)+1
+	    IF(iseiff.LT.nseiff-1) THEN
+	       temp(il)=tseiff(iseiff)+(zkm(il)-2.*(iseiff-1))*
+     $         (tseiff(iseiff+1)-tseiff(iseiff))/2.
+	    ELSE
+	       temp(il)=tseiff(nseiff)
+	    ENDIF
+	 ENDDO
+c IF(ichoice.EQ.6) THEN
+c	    DO iter=1,6
+c	    t2=temp(1)
+c	    t3=temp(2)
+c	    DO il=2,nlev-1
+c	       t1=t2
+c	       t2=t3
+c	       t3=temp(il+1)
+c	       ww=tanh(zkm(il)/20.)
+c	       ww=ww*ww*ww
+c	       temp(il)=t2+ww*.5*(t1-2.*t2+t3)
+c	    ENDDO
+c	    ENDDO
+c	 ENDIF
+
+c-----------------------------------------------------------------------
+c   ichoice=6 
+c   ---------
+
+      ELSE IF(ichoice.EQ.6) THEN
+      DO il=1,nlev
+        tmp=il-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp/largeur/largeur)
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=7
+c   ---------
+
+      ELSE IF(ichoice.EQ.7) THEN
+      DO il=1,nlev
+        tmp=zkm(il)-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp*4/largeur/largeur)
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=8
+c   ---------
+
+      ELSE IF(ichoice.GE.8) THEN
+      OPEN(11,file='profile',status='old',form='formatted',err=101)
+      DO il=1,nlev
+        READ (11,*) temp(il)
+      ENDDO
+
+      GOTO 201
+101   STOP'fichier profile inexistant'
+201   CONTINUE
+      CLOSE(10)
+
+c-----------------------------------------------------------------------
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   rajout eventuel d'une perturbation:
+c   -----------------------------------
+
+      IF(isin.EQ.1) THEN
+	 pi=2.*ASIN(1.)
+	 DO il=1,nlev
+c       if (nlev.EQ.501) then
+c         if (zkm(il).LE.70.5) then
+c       temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+c    s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c         endif
+c       else
+        temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+     s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c       endif
+	 ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   Ecriture du profil de temperature dans un fichier profile.out
+c   -------------------------------------------------------------
+
+
+      OPEN(12,file='profile.out',form='formatted')
+	  DO il=1,nlev
+	    write(12,*) temp(il)
+	  ENDDO
+      CLOSE(12)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/readtesassim.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/readtesassim.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/readtesassim.F90	(revision 46)
@@ -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: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scatter.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scatter.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scatter.F	(revision 46)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scopyi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scopyi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/scopyi.F	(revision 46)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/slope.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/slope.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/slope.h	(revision 46)
@@ -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/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil.F	(revision 46)
@@ -0,0 +1,166 @@
+      subroutine soil(ngrid,nsoil,firstcall,
+     &          therm_i,
+     &          timestep,tsurf,tsoil,
+     &          capcal,fluxgrd)
+      implicit none
+
+!-----------------------------------------------------------------------
+!  Author: Ehouarn Millour
+!
+!  Purpose: Compute soil temperature using an implict 1st order scheme
+!  
+!  Note: depths of layers and mid-layers, soil thermal inertia and 
+!        heat capacity are commons in comsoil.h
+!-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+
+#include"comsoil.h"
+
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      integer ngrid	! number of (horizontal) grid-points 
+      integer nsoil	! number of soil layers 
+      logical firstcall ! identifier for initialization call 
+      real therm_i(ngrid,nsoil) ! thermal inertia
+      real timestep	    ! time step
+      real tsurf(ngrid)   ! surface temperature
+! outputs:
+      real tsoil(ngrid,nsoil) ! soil (mid-layer) temperature
+      real capcal(ngrid) ! surface specific heat
+      real fluxgrd(ngrid) ! surface diffusive heat flux
+
+! local saved variables:
+!      real,save :: layer(ngridmx,nsoilmx)	! layer depth
+      real,save :: mthermdiff(ngridmx,0:nsoilmx-1) ! mid-layer thermal diffusivity
+      real,save :: thermdiff(ngridmx,nsoilmx-1) ! inter-layer thermal diffusivity
+      real,save :: coefq(0:nsoilmx-1)		! q_{k+1/2} coefficients
+      real,save :: coefd(ngridmx,nsoilmx-1)	! d_k coefficients
+      real,save :: alph(ngridmx,nsoilmx-1)	! alpha_k coefficients
+      real,save :: beta(ngridmx,nsoilmx-1)	! beta_k coefficients
+      real,save :: mu
+      
+! local variables:
+      integer ig,ik
+
+! 0. Initialisations and preprocessing step
+      if (firstcall) then
+      ! note: firstcall is set to .true. or .false. by the caller
+      !       and not changed by soil.F 
+! 0.1 Build mthermdiff(:), the mid-layer thermal diffusivities
+      do ig=1,ngrid
+        do ik=0,nsoil-1
+	  mthermdiff(ig,ik)=therm_i(ig,ik+1)*therm_i(ig,ik+1)/volcapa
+!	  write(*,*),'soil: ik: ',ik,' mthermdiff:',mthermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.2 Build thermdiff(:), the "interlayer" thermal diffusivities
+      do ig=1,ngrid
+        do ik=1,nsoil-1
+      thermdiff(ig,ik)=((layer(ik)-mlayer(ik-1))*mthermdiff(ig,ik)
+     &                +(mlayer(ik)-layer(ik))*mthermdiff(ig,ik-1))
+     &                    /(mlayer(ik)-mlayer(ik-1))
+!	write(*,*),'soil: ik: ',ik,' thermdiff:',thermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.3 Build coefficients mu, q_{k+1/2}, d_k, alpha_k and capcal
+      ! mu
+      mu=mlayer(0)/(mlayer(1)-mlayer(0))
+
+      ! q_{1/2}
+      coefq(0)=volcapa*layer(1)/timestep
+	! q_{k+1/2}
+        do ik=1,nsoil-1
+          coefq(ik)=volcapa*(layer(ik+1)-layer(ik))
+     &                 /timestep
+	enddo
+
+      do ig=1,ngrid
+	! d_k
+	do ik=1,nsoil-1
+	  coefd(ig,ik)=thermdiff(ig,ik)/(mlayer(ik)-mlayer(ik-1))
+	enddo
+	
+	! alph_{N-1}
+	alph(ig,nsoil-1)=coefd(ig,nsoil-1)/
+     &                  (coefq(nsoil-1)+coefd(ig,nsoil-1))
+        ! alph_k
+        do ik=nsoil-2,1,-1
+	  alph(ig,ik)=coefd(ig,ik)/(coefq(ik)+coefd(ig,ik+1)*
+     &                              (1.-alph(ig,ik+1))+coefd(ig,ik))
+	enddo
+
+        ! capcal
+! Cstar
+        capcal(ig)=volcapa*layer(1)+
+     &              (thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (timestep*(1.-alph(ig,1)))
+! Cs
+        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+!      write(*,*)'soil: ig=',ig,' capcal(ig)=',capcal(ig)
+      enddo ! of do ig=1,ngrid
+            
+      else ! of if (firstcall)
+
+!  1. Compute soil temperatures
+! First layer:
+      do ig=1,ngrid
+        tsoil(ig,1)=(tsurf(ig)+mu*beta(ig,1)*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))/
+     &              (1.+mu*(1.0-alph(ig,1))*
+     &               thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+! Other layers:
+      do ik=1,nsoil-1
+        do ig=1,ngrid
+	  tsoil(ig,ik+1)=alph(ig,ik)*tsoil(ig,ik)+beta(ig,ik)
+	enddo
+      enddo
+      
+      endif! of if (firstcall)
+
+!  2. Compute beta coefficients (preprocessing for next time step)
+! Bottom layer, beta_{N-1}
+      do ig=1,ngrid
+        beta(ig,nsoil-1)=coefq(nsoil-1)*tsoil(ig,nsoil)
+     &                   /(coefq(nsoil-1)+coefd(ig,nsoil-1))
+      enddo
+! Other layers
+      do ik=nsoil-2,1,-1
+        do ig=1,ngrid
+	  beta(ig,ik)=(coefq(ik)*tsoil(ig,ik+1)+
+     &                 coefd(ig,ik+1)*beta(ig,ik+1))/
+     &                 (coefq(ik)+coefd(ig,ik+1)*(1.0-alph(ig,ik+1))
+     &                  +coefd(ig,ik))
+	enddo
+      enddo
+
+!  3. Compute surface diffusive flux & calorific capacity
+      do ig=1,ngrid
+! Cstar
+!        capcal(ig)=volcapa(ig,1)*layer(ig,1)+
+!     &              (thermdiff(ig,1)/(mlayer(ig,1)-mlayer(ig,0)))*
+!     &              (timestep*(1.-alph(ig,1)))
+! Fstar
+        fluxgrd(ig)=(thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (beta(ig,1)+(alph(ig,1)-1.0)*tsoil(ig,1))
+
+!        mu=mlayer(ig,0)/(mlayer(ig,1)-mlayer(ig,0))
+!        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+!     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+! Fs
+        fluxgrd(ig)=fluxgrd(ig)+(capcal(ig)/timestep)*
+     &              (tsoil(ig,1)*(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+     &               -tsurf(ig)-mu*beta(ig,1)*
+     &                          thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil_settings.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil_settings.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/soil_settings.F	(revision 46)
@@ -0,0 +1,406 @@
+      subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil)
+      implicit none
+
+!======================================================================
+!  Author: Ehouarn Millour (07/2006)
+!
+!  Purpose: Read and/or initialise soil depths and properties
+!
+!  This subroutine reads from a NetCDF file (opened by the caller)
+!  of "startfi.nc" format.
+!  The various actions and variable read/initialized are:
+!  1. Check out the number of soil layers (in datafile); if it isn't equal
+!     to nsoil, then some interpolation will be required
+!     Also check if data in file "startfi.nc" is in older format (ie:
+!     thermal inertia was depth-independent; and there was no "depth"
+!     coordinate.
+!     Read/build layer (and midlayer) depths
+!  2. Read volumetric specific heat (or initialise it to default value)
+!  3. Read Thermal inertia
+!  4. Read soil temperatures
+!  5. Interpolate thermal inertia and temperature on the new grid, if
+!     necessary
+!======================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+
+#include "comsoil.h"
+#include "netcdf.inc"
+!======================================================================
+!  arguments
+!  ---------
+!  inputs:
+      integer nid	! Input Netcdf file ID 
+      integer ngrid	! # of horizontal grid points
+      integer nsoil	! # of soil layers
+      real tsurf(ngrid) ! surface temperature
+!  output:
+      real tsoil(ngridmx,nsoilmx)	! soil temperature
+
+!======================================================================
+! local variables:
+      integer ierr	! status (returned by NetCDF functions)
+      integer nvarid	! ID of NetCDF variable
+      integer dimid	! ID of NetCDF dimension
+      integer dimlen	! length along the "depth" dimension
+      integer ndims	! # of dimensions of read <inertiedat> data
+      integer ig,iloop	! loop counters
+
+      logical :: olddepthdef=.false. ! flag
+      logical :: interpol=.false. ! flag: true if interpolation will be requiered
+
+      ! to store "old" values
+      real,dimension(:),allocatable :: surfinertia !surface thermal inertia
+      real,dimension(:),allocatable :: oldmlayer
+      real,dimension(:,:),allocatable :: oldinertiedat
+      real,dimension(:,:),allocatable :: oldtsoil
+      
+      ! for interpolation
+      real,dimension(:),allocatable :: oldgrid
+      real,dimension(:),allocatable :: oldval
+      real,dimension(:),allocatable :: newval
+
+      real alpha,lay1 ! coefficients for building layers
+      real xmin,xmax ! to display min and max of a field
+
+      real,parameter :: default_volcapa=1.e6
+
+!======================================================================
+
+! 1. Depth coordinate
+! -------------------
+
+! 1.1 Start by reading how many layers of soil there are
+
+	ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
+	 call abort
+	endif
+
+	ierr=NF_INQ_DIMLEN(nid,dimid,dimlen)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
+     &             'length'
+	 call abort
+	endif
+
+        if (dimlen.ne.nsoil) then
+          write(*,*)'soil_settings: Interpolation of soil temperature ',
+     &              'and thermal inertia will be required!'
+	! if dimlen doesn't match nsoil, then interpolation of
+	! soil temperatures and thermal inertia will be requiered
+	  interpol=.true.
+	endif
+
+! 1.2 Find out the # of dimensions <inertiedat> was defined as using
+!     (in ye old days, thermal inertia was only given at the "surface")
+      ! Look for thermal inertia data
+      ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Field <inertiedat> not found!'
+         call abort
+      endif
+
+      ! Read the # of dimensions <inertidat> was defined as using
+      ierr=NF_INQ_VARNDIMS(nid,nvarid,ndims)
+      ! if (ndims.eq.1) then we have the "old 2D-surface" format
+
+! 1.3 Read depths values or set olddepthdef flag and values
+      if (ndims.eq.1) then ! we know that there is none
+        write(*,*)'soil_settings: no <soildepth> field expected'
+	write(*,*)'building one mimicking old definitions'
+        olddepthdef=.true.
+	interpol=.true.
+        ! allocate oldmlayer
+        if (.not.allocated(oldmlayer)) then
+          allocate(oldmlayer(dimlen),stat=ierr)
+          if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of oldmlayer!'
+            stop
+          endif
+        endif
+	do iloop=1,dimlen
+	  oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.)
+	enddo
+      else ! Look for depth 
+        ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+        if (ierr.ne.NF_NOERR) then
+          write(*,*)'soil_settings: Field <soildepth> not found!'
+	  call abort
+        endif
+        ! read <depth> coordinate
+        if (interpol) then !put values in oldmlayer
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldmlayer)
+#else
+           ierr = NF_GET_VAR_REAL(nid,nvarid,oldmlayer)
+#endif
+          if (ierr.ne.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <soildepth>'
+           call abort
+          endif
+        else ! put values in mlayer
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+           ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+          if (ierr.ne.NF_NOERR) then
+           write(*,*)'soil_settings: Problem while reading <soildepth>'
+           call abort
+          endif
+        endif !of if (interpol)
+      endif !of if (ndims.eq.1)
+
+! 1.4 Build mlayer(), if necessary
+      if (interpol) then
+      ! default mlayer distribution, following a power law:
+      !  mlayer(k)=lay1*alpha**(k-1/2)
+        lay1=2.e-4
+	alpha=2
+        do iloop=0,nsoil-1
+	  mlayer(iloop)=lay1*(alpha**(iloop-0.5))
+	enddo
+      endif
+
+! 1.5 Build layer(); following the same law as mlayer()
+      ! Assuming layer distribution follows mid-layer law:
+      ! layer(k)=lay1*alpha**(k-1)
+      lay1=sqrt(mlayer(0)*mlayer(1))
+      alpha=mlayer(1)/mlayer(0)
+      do iloop=1,nsoil
+        layer(iloop)=lay1*(alpha**(iloop-1))
+      enddo
+
+! 2. Volumetric heat capacity (note: it is declared in comsoil.h)
+! ---------------------------
+! "volcapa" is (so far) 0D and written in "controle" table of startfi file 
+! volcapa is read or set when "controle" is read (see tabfi.F)
+! Just in case, we check here that it is not zero. If it is, we
+! set it to "default_volcapa"
+
+      if (volcapa.le.0.0) then
+        write(*,*)'soil_settings: Warning, volcapa = ',volcapa
+	write(*,*)'               That doesn t seem right'
+        write(*,*)'        Initializing Volumetric heat capacity to ',
+     &             default_volcapa
+	volcapa=default_volcapa
+      endif
+! Look for it
+!      ierr=NF_INQ_VARID(nid,"volcapa",nvarid)
+!      if (ierr.NE.NF_NOERR) then
+!         write(*,*)'soil_settings: Field <volcapa> not found!'
+!         write(*,*)'Initializing Volumetric heat capacity to ',
+!     &             default_volcapa
+!         volcapa=default_volcapa
+!      else
+!#ifdef NC_DOUBLE
+!       ierr = NF_GET_VAR_DOUBLE(nid,nvarid,volcapa)
+!#else
+!       ierr = NF_GET_VAR_REAL(nid,nvarid,volcapa)
+!#endif
+!        if (ierr.ne.NF_NOERR) then
+!	  write(*,*)'soil_settings: Problem while reading <volcapa>'
+!         call abort
+!	endif
+!      endif
+
+! 3. Thermal inertia (note: it is declared in comsoil.h)
+! ------------------
+
+! 3.1 Look (again) for thermal inertia data (to reset nvarid)
+      ierr=NF_INQ_VARID(nid, "inertiedat", nvarid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Field <inertiedat> not found!'
+         call abort
+      endif
+
+! 3.2 Knowing the # of dimensions <inertidat> was defined as using,
+!     read/build thermal inertia
+
+      if (ndims.eq.1) then ! "old 2D-surface" format
+       write(*,*)'soil_settings: Thermal inertia is only given as surfac
+     &e data!'
+       ! Read Surface thermal inertia
+       allocate(surfinertia(ngrid))
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, surfinertia)
+#else
+       ierr = NF_GET_VAR_REAL(nid, nvarid, surfinertia)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       
+       write(*,*)' => Building soil thermal inertia (using reference sur
+     &face thermal inertia)'
+       do iloop=1,nsoil
+         inertiedat(:,iloop)=surfinertia(:)
+       enddo
+       deallocate(surfinertia)
+
+      else ! "3D surface+depth" format
+       if (interpol) then ! put values in oldinertiedat
+         if (.not.allocated(oldinertiedat)) then
+           allocate(oldinertiedat(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of ',
+     &                 'oldinertiedat!'
+            stop
+           endif
+         endif
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,oldinertiedat)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,oldinertiedat)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       else ! put values in therm_i
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedat)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedat)
+#endif
+        if (ierr.NE.NF_NOERR) then
+         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+         call abort
+        endif
+       endif ! of if (interpol)
+      endif ! of if (ndims.eq.1)
+      
+! 4. Read soil temperatures
+! -------------------------
+
+      ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*)'soil_settings: Field <tsoil> not found!'
+	write(*,*)' => Building <tsoil> from surface values <tsurf>'
+	do iloop=1,nsoil
+	  tsoil(:,iloop)=tsurf(:)
+	enddo
+      else ! <tsoil> found
+       if (interpol) then ! put values in oldtsoil
+         if (.not.allocated(oldtsoil)) then
+           allocate(oldtsoil(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+             write(*,*) 'soil_settings: failed allocation of ',
+     &                  'oldtsoil!'
+             stop
+           endif
+         endif
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VAR_DOUBLE(nid,nvarid,oldtsoil)
+#else
+        ierr=NF_GET_VAR_REAL(nid,nvarid,oldtsoil)
+#endif
+        if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+	 call abort
+	endif
+       else ! put values in tsoil
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VAR_DOUBLE(nid,nvarid,tsoil)
+#else
+        ierr=NF_GET_VAR_REAL(nid,nvarid,tsoil)
+#endif
+        if (ierr.ne.NF_NOERR) then
+	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+	 call abort
+	endif
+       endif ! of if (interpol) 
+      endif
+
+! 5. If necessary, interpolate soil temperatures and thermal inertias
+! -------------------------------------------------------------------
+
+      if (olddepthdef) then
+      ! tsoil needs to be interpolated, but not therm_i
+        allocate(oldgrid(dimlen+1))
+        allocate(oldval(dimlen+1))
+	allocate(newval(nsoil))
+
+        do ig=1,ngrid
+	  ! copy values
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! build vertical coordinate
+	  oldgrid(1)=0. ! ground
+	  oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)*
+     &                (inertiedat(ig,1)/volcapa)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in tsoil
+	  tsoil(ig,:)=newval(:)
+	enddo
+
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	interpol=.false. ! no need for interpolation any more      
+      endif !of if (olddepthdef)
+
+      if (interpol) then
+      write(*,*)'soil_settings: Vertical interpolation along new grid'
+      ! interpolate soil temperatures and thermal inertias
+        if (.not.allocated(oldgrid)) then
+          allocate(oldgrid(dimlen+1))
+          allocate(oldval(dimlen+1))
+	  allocate(newval(nsoil))
+        endif
+
+      ! thermal inertia
+        do ig=1,ngrid
+	  ! copy data
+	  oldval(1:dimlen)=oldinertiedat(ig,dimlen)
+	  ! interpolate
+	  call interp_line(oldmlayer,oldval,dimlen,mlayer,newval,nsoil)
+	  !copy result in inertiedat
+	  inertiedat(ig,:)=newval(:)
+	enddo
+        
+      ! soil temperature
+        ! vertical coordinate
+	oldgrid(1)=0.0
+	oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)
+        do ig=1,ngrid
+	  ! data
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in inertiedat
+	  tsoil(ig,:)=newval(:)
+	enddo
+	
+	!cleanup
+        deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	deallocate(oldinertiedat)
+	deallocate(oldtsoil)
+      endif ! of if (interpol)
+      
+! 6. Report min and max values of soil temperatures and thermal inertias
+! ----------------------------------------------------------------------
+
+      write(*,*)
+      write(*,*)'Soil volumetric heat capacity:',volcapa
+
+      xmin = MINVAL(inertiedat)
+      xmax = MAXVAL(inertiedat)
+      write(*,*)'Soil thermal inertia <inertiedat>:',xmin,xmax
+
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(tsoil)
+      xmax = MAXVAL(tsoil)
+      write(*,*)'Soil temperature <tsoil>:',xmin,xmax
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solang.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solang.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solang.F	(revision 46)
@@ -0,0 +1,114 @@
+      subroutine solang ( kgrid,psilon,pcolon,psilat,pcolat,
+     &                    ptim1,ptim2,ptim3,pmu0,pfract )
+      IMPLICIT NONE
+
+C
+C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
+C
+C     PURPOSE.
+C     --------
+C          CALCULATES THE SOLAR ANGLE FOR ALL THE POINTS OF THE GRID
+C
+C**   INTERFACE.
+C     ----------
+C      SUBROUTINE SOLANG ( KGRID )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS  ===
+C
+C PSILON(KGRID)   : SINUS OF THE LONGITUDE
+C PCOLON(KGRID)   : COSINUS OF THE LONGITUDE
+C PSILAT(KGRID)   : SINUS OF THE LATITUDE
+C PCOLAT(KGRID)   : COSINUS OF THE LATITUDE
+C PTIM1           : SIN(DECLI)
+C PTIM2           : COS(DECLI)*COS(TIME)
+C PTIM3           : SIN(DECLI)*SIN(TIME)
+C
+C     ==== OUTPUTS ===
+C
+C PMU0 (KGRID)    : SOLAR ANGLE
+C PFRACT(KGRID)   : DAY FRACTION OF THE TIME INTERVAL
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C         NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C         RADIATIVE PROCESSES IN METEOROLOGIE AND CLIMATOLOGIE
+C         PALTRIDGE AND PLATT
+C
+C     AUTHOR.
+C     -------
+C        FREDERIC HOURDIN
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL :90-01-14
+C                  92-02-14 CALCULATIONS DONE THE ENTIER GRID (J.Polcher)
+C-----------------------------------------------------------------------
+C
+C     ------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+C
+C*      0.1   ARGUMENTS
+C             ---------
+C
+      INTEGER kgrid
+      REAL ptim1,ptim2,ptim3
+      REAL psilon(kgrid),pcolon(kgrid),pmu0(kgrid),pfract(kgrid)
+      REAL psilat(kgrid), pcolat(kgrid)
+C
+      INTEGER jl
+      REAL ztim1,ztim2,ztim3
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C
+C------------------------------------------------------------------------
+C
+C*     1.     INITIALISATION
+C             --------------
+C
+ 100  CONTINUE
+C
+      DO jl=1,kgrid
+        pmu0(jl)=0.
+        pfract(jl)=0.
+      ENDDO
+C
+C*     1.1     COMPUTATION OF THE SOLAR ANGLE
+C              ------------------------------
+C
+      DO jl=1,kgrid
+        ztim1=psilat(jl)*ptim1
+        ztim2=pcolat(jl)*ptim2
+        ztim3=pcolat(jl)*ptim3
+        pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
+      ENDDO
+C
+C*     1.2      DISTINCTION BETWEEN DAY AND NIGHT
+C               ---------------------------------
+C
+      DO jl=1,kgrid
+        IF (pmu0(jl).gt.0.) THEN
+          pfract(jl)=1.
+c       pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
+      ELSE
+c       pmu0(jl)=0.
+        pfract(jl)=0.
+        ENDIF
+      ENDDO
+C
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solarlong.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solarlong.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/solarlong.F	(revision 46)
@@ -0,0 +1,107 @@
+      SUBROUTINE solarlong(pday,psollong)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c      Calcul de la distance soleil-planete et de la declinaison
+c   en fonction du jour de l'annee.
+c
+c
+c   Methode:
+c   --------
+c
+c      Calcul complet de l'elipse
+c
+c   Interface:
+c   ----------
+c
+c      Uncommon comprenant les parametres orbitaux.
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
+c   lwrite        clef logique pour sorties de controle
+c
+c   Output:
+c   -------
+c   pdist_sol     distance entre le soleil et la planete
+c                 ( en unite astronomique pour utiliser la constante 
+c                  solaire terrestre 1370 Wm-2 )
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_sol,pdecli,psollong
+      LOGICAL lwrite
+
+c Local:
+c ------
+
+      REAL zanom,xref,zx0,zdx,zteta,zz
+      INTEGER iter
+
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c   Initialisation eventuelle:
+      if(.not.unitastr.gt.1.e-4) then
+         call iniorbit(249.22,206.66,669.,485.,25.2)
+      endif
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(pday-peri_day)/year_day
+      pi=2.*asin(1.)
+      zanom=2.*pi*(zz-nint(zz))
+      xref=abs(zanom)
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
+c  methode de Newton
+
+      zx0=xref+e_elips*sin(xref)
+      DO 110 iter=1,10
+         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-7)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+
+c zteta est la longitude solaire
+
+      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+
+      psollong=zteta-timeperi
+
+      IF(psollong.LT.0.) psollong=psollong+2.*pi
+      IF(psollong.GT.2.*pi) psollong=psollong-2.*pi
+c-----------------------------------------------------------------------
+c   sorties eventuelles:
+c   ---------------------
+
+c     IF (lwrite) THEN
+c        PRINT*,'jour de l"annee   :',pday
+c        PRINT*,'distance au soleil (en unite astronomique) :',pdist_sol
+c        PRINT*,'declinaison (en degres) :',pdecli*180./pi
+c     ENDIF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/calldrag_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/calldrag_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/calldrag_noro.F	(revision 46)
@@ -0,0 +1,205 @@
+      SUBROUTINE calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 pplay,pplev,pt,pu,pv,pdtgw,pdugw,pdvgw) 
+
+
+
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call SUBROUTINE drag_noro 
+c   Interface for sub-grid scale orographic scheme
+c   The purpose of this subroutine is
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h.
+c
+c   author:   
+c   ------
+c           Christophe Hourdin/ Francois Forget
+c
+c   changes:
+c   -------
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   input:
+c   ----- 
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   ptimestep             Physical timestep (s)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature  (K)
+c   pu(ngrid,nlayer)       zonal wind (m s-1)
+c   pv(ngrid,nlayer)       meridional wind (m s-1)
+c
+c   output:
+c   -------
+c   pdtgw(ngrid,nlayer)    Temperature trend (K.s-1)
+c   pdugw(ngrid,nlayer)    zonal wind trend  (m.s-2)
+c   pdvgw(ngrid,nlayer)    meridional wind trend  (m.s-2)
+c
+c
+c
+c
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "surfdat.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer  
+
+      real ptimestep
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer), pu(ngrid,nlayer),pv(ngrid,nlayer)
+      REAL pdtgw(ngrid,nlayer), pdugw(ngrid,nlayer),pdvgw(ngrid,nlayer)
+
+
+c
+c    Local variables :
+c    -----------------
+
+      REAL sigtest(nlayermx+1)
+      INTEGER igwd,igwdim,itest(ngridmx)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+      INTEGER l,ig
+      INTEGER jd,ig0,nd
+
+      REAL zulow(ngridmx),zvlow(ngridmx)
+      REAL zustr(ngridmx),zvstr(ngridmx)
+
+      REAL zplev(ndomainsz,nlayermx+1)
+      REAL zplay(ndomainsz,nlayermx)
+      REAL zt(ndomainsz,nlayermx)
+      REAL zu(ndomainsz,nlayermx)
+      REAL zv(ndomainsz,nlayermx)
+      INTEGER zidx(ndomainsz)
+      REAL zzdtgw(ndomainsz,nlayermx)
+      REAL zzdugw(ndomainsz,nlayermx)
+      REAL zzdvgw(ndomainsz,nlayermx)
+
+      logical ll
+
+
+c   local saved variables
+c   ---------------------
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+         do l=1,nlayermx+1
+           sigtest(l)=pplev(1,l)/pplev(1,1)
+         enddo
+         call sugwd(nlayermx,sigtest)
+
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, meme pour drag_noro '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+
+         firstcall=.false.
+      END IF
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+          nd=ngridmx-ig0
+        else
+          nd=ndomainsz
+        endif
+
+c       Detecting points concerned by the scheme
+c       ----------------------------------------
+
+        igwd=0
+        DO ig=ig0+1,ig0+nd
+          itest(ig)=0
+          ll=zstd(ig).gt.50.0
+          IF(ll) then
+            itest(ig)=1
+            igwd=igwd+1
+            zidx(igwd)=ig - ig0
+          ENDIF
+        ENDDO
+        IGWDIM=MAX(1,IGWD)
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlayer+1
+          do ig = 1,nd
+           zplev(ig,l) = pplev(ig0+ig,l)
+          enddo
+        enddo
+
+        do l=1,nlayer
+          do ig = 1,nd
+            zplay(ig,l) = pplay(ig0+ig,l)
+            zt(ig,l) = pt(ig0+ig,l)
+            zu(ig,l) = pu(ig0+ig,l)
+            zv(ig,l) = pv(ig0+ig,l)
+          enddo
+        enddo
+
+c       Calling gravity wave and subgrid scale topo parameterization
+c       -------------------------------------------------------------
+
+        call drag_noro (nd,nlayer,ptimestep,zplay,zplev,
+     e        zstd(ig0+1),zsig(ig0+1),zgam(ig0+1),zthe(ig0+1),
+     e        igwd,igwdim,zidx,itest(ig0+1),
+     e        zt, zu, zv,
+     s        zulow(ig0+1),zvlow(ig0+1),zustr(ig0+1),zvstr(ig0+1),
+     s        zzdtgw,zzdugw,zzdvgw)
+
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+c       (and devide by ptimestep -> true tendancies)
+
+        do l=1,nlayer
+         do ig = 1,nd
+          pdtgw(ig0+ig,l) = zzdtgw(ig,l)/ptimestep
+          pdugw(ig0+ig,l) = zzdugw(ig,l)/ptimestep
+          pdvgw(ig0+ig,l) = zzdvgw(ig,l)/ptimestep
+         enddo
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/callradite.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/callradite.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/callradite.F	(revision 46)
@@ -0,0 +1,486 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,rice,nuice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c      3) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      4) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   This 3D size distribution is loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rice(ngridmx,nlayermx)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n,ich,iaer
+      INTEGER jd,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      real znetrad(ndomainsz,nflev)
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
+
+      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                pplev,pplay,
+     &                rice,nuice,
+     &                reffrad,nueffrad)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,pq,
+     &      tauref,tau,aerosol,reffrad,
+     &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d)
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+           do iaer = 1, naerkind
+             do ich = 1, nsun
+               zQVISsQREF3d(ig,l,ich,iaer) = 
+     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaVIS3d(ig,l,ich,iaer) = 
+     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+               zgVIS3d(ig,l,ich,iaer) = 
+     &                           gVIS3d(ig0+ig,l,ich,iaer)
+             enddo
+             do ich = 1, nir
+               zQIRsQREF3d(ig,l,ich,iaer) = 
+     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaIR3d(ig,l,ich,iaer) = 
+     &                           omegaIR3d(ig0+ig,l,ich,iaer)
+               zgIR3d(ig,l,ich,iaer) = 
+     &                           gIR3d(ig0+ig,l,ich,iaer)
+             enddo
+           enddo
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
+         ENDDO
+        ENDDO
+
+        DO ig=1, nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad
+     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev,
+     S     cste_mars, zalbedo,
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw,
+     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
+
+c       ------------------------------------------------------------
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/dimradmars.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/dimradmars.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/dimradmars.h	(revision 46)
@@ -0,0 +1,86 @@
+! ----------------------------------------------------------------------
+! -----------------------------------------------------------------------
+!   INCLUDE 'dimradmars.h'
+
+!   Declaration and initialisation or radiative transfer calculations
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+
+! nflev: number of vertical layer
+! ndlon,ndlo2: number of horizontal points
+! Splitting of horizontal grid
+! NDLO2 et ndomainsz pour le decoupage de l'appel a la physique
+! ATTENTION:  Il faut  1 < ndomainsz =< ngridmx
+
+      INTEGER  NFLEV,NDLON,NDLO2,ndomainsz
+
+!     parameter (ndomainsz=ngridmx)
+      parameter (ndomainsz=(ngridmx-1)/20 + 1)
+!     parameter (ndomainsz=(ngridmx-1)/5 + 1) 
+
+      parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage
+      parameter (NDLO2=NDLON)
+
+! Number of kind of tracer radiative properties 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! (ex: naerkind=1 if you use one dust mode without ice ...)
+! (ex: naerkind=2 if you use one dust mode and active ice ...)
+      integer naerkind
+      parameter (naerkind=1)
+
+! Reference wavelengths used to compute reference optical depth (m)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REAL longrefir(naerkind),longrefvis(naerkind)
+
+      REAL long1vis,long2vis,long3vis, long1ir,long2ir
+      REAL long1co2,long2co2
+      REAL sunfr(2)
+      integer nir, nuco2
+      INTEGER npademx,nabsmx,nt_pademx, NSUN
+
+
+! Definition of spectral intervals at thermal infrared wavelengths (LW)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      parameter (nir=4) ! Total number of thermal IR bands
+      parameter (nuco2=2) ! number of bands in CO2 bands
+      PARAMETER (long1ir=5.E-6 , long2ir=200.E-6)
+      PARAMETER (long1co2=1.E+0 / 865.E+2 , long2co2=1.E+0 / 500.E+2)
+
+!  Warning : the "nir" thermal IR bands are not ordered by wavelength:
+!      iir=1 : central 15um CO2 bands \    
+!      iir=2 : CO2 band wings    [long1co2-long2co2] MINUS central band
+!      iir=3 : 9 um band [long1ir - long1co2]
+!      iir=4 : Far IR    [long2co2 - long2ir]
+    
+!  Definition of spectral interval at solar wavelengths (SW)
+!  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      PARAMETER (NSUN=2)   ! do not change that !
+!  Boundaries of spectral intervals (m) : 
+      PARAMETER (long1vis=0.1E-6 , long2vis=0.5E-6 , long3vis=5.E-6)
+!  Fraction of solar energy in solar band #1 [long1vis-long2vis]
+      DATA sunfr(1) / 0.274490 /  
+!  Fraction of solar energy in solar band #2 [long2vis-long3vis]
+      DATA sunfr(2) / 0.725509 /
+
+! Maximum number of grain size classes
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! This parameter has to be set to the maximum number of particle
+!   sizes contained in the optical parameter database; For example,
+!   if only one grain size is used to describe dust, and 30 are used
+!   to describe water-ice crystals in the visible and 15 in the IR,
+!   nsizemax has to be set to 30.
+! If only one grain size is considered for all the aerosols, set
+!   this parameter to 1 and convolution will be turned off during
+!   the radiative calculations.
+
+!     INTEGER, PARAMETER :: nsizemax = 60
+      INTEGER, PARAMETER :: nsizemax = 1
+
+! Various initialisation for LW radiative code
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! npademx : nombre de coef de pade 
+! nabsmx : ?
+! nt_pademx : nombre d'intervalles de temperature pour pade
+
+      PARAMETER (npademx=4,nabsmx=2,nt_pademx=19)
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwflux.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwflux.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwflux.F	(revision 46)
@@ -0,0 +1,513 @@
+       subroutine lwflux (ig0,kdlon,kflev,dp
+     .                   ,bsurf,btop,blev,blay,dbsublay
+     .                   ,tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .                   ,emis
+     .                   , tautotal,omegtotal,gtotal
+     .                   ,coolrate,fluxground,fluxtop
+     .                   ,netrad)
+
+c----------------------------------------------------------------------
+c     LWFLUX     computes the fluxes
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon                 ! part of ngrid
+      integer kflev                 ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+
+      real bsurf (ndlo2,nir)             ! surface spectral planck function
+      real blev (ndlo2,nir,kflev+1)      ! level   spectral planck function
+      real blay (ndlo2,nir,kflev)        ! layer   spectral planck function
+      real btop (ndlo2,nir)              ! top spectral planck function
+      real dbsublay (ndlo2,nir,2*kflev)  ! layer gradient spectral planck
+                                         ! function in sub layers
+
+      real dt0 (ndlo2)                 ! surface temperature discontinuity
+      real tlay (ndlo2,kflev)          ! layer temperature
+      real tlev (ndlo2,kflev+1)        ! level temperature
+
+      real emis (ndlo2)                  ! surface emissivity
+
+      real tautotal(ndlo2,kflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlo2,kflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlo2,kflev,nir)    ! /   NAERKIND aerosols prop.)
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)    ! radiative cooling rate (K/s) 
+      real netrad (ndlo2,kflev)     ! radiative budget (W/m2) 
+      real fluxground(ndlo2)        ! downward flux on the ground
+                                    ! for surface radiative budget
+      real fluxtop(ndlo2)           ! upward flux on the top of atm ("OLR")
+
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,j,i,ig1d,ig,l,ndim
+      parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2))
+      real  ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2)
+
+      real dpsgcp (0:nflev+1,0:nflev+1)    !  dp/(g.cp)
+      real temp (0:nflev+1,0:nflev+1)       
+
+      real fluxdiff(ndlon,2,nflev+1)  ! diffusion flux: upward(1) downward(2) 
+
+      real*4 reel4
+
+c     To compute IR flux in the atmosphere  (For diagnostic only !!)
+      logical computeflux
+      real coefd(ngridmx,nuco2,nflev+1,nflev+1) 
+      real coefu(ngridmx,nuco2,0:nflev,nflev+1)
+      real flw_up(ngridmx,nflev+1), flw_dn(ngridmx,nflev+1) ! fluxes (W/m2)
+
+
+      call zerophys(ndim, ksidb)
+
+c----------------------------------------------------------------------
+c         1.1   exchanges (layer i <--> all layers up to i) 
+c               -------------------------------------------
+
+      do i = 1,nlaylte
+        do j = i+1,nlaylte
+          do ja = 1,nuco2
+            do jl = 1,kdlon
+
+      ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j)
+     .                 * (blay(jl,ja,j)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,j,i) = -ksidb(jl,ja,i,j)
+      
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   exchanges (ground <--> all layers) 
+c               ----------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i)
+     .                 * (bsurf(jl,ja)-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,0,i) = -ksidb(jl,ja,i,0)
+
+          enddo
+        enddo
+      enddo
+
+c--------------------------------------------------------
+c  Here we add the neighbour contribution 
+c           for exchanges between ground and first layer
+c--------------------------------------------------------
+
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) 
+     .                 - xi_ground(ig0+jl,ja)
+     .                 * (blev(jl,ja,1)-blay(jl,ja,1))
+
+cc                                                       ksidb reciprocity
+cc                                                       -----------------
+      ksidb(jl,ja,0,1) = - ksidb(jl,ja,1,0)
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         1.3   exchanges (layer i <--> space) 
+c               ------------------------------
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) 
+     .                       * (-blay(jl,ja,i))
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,i) = - ksidb(jl,ja,i,nlaylte+1)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.4   exchanges (ground <--> space) 
+c               -----------------------------
+
+      do ja = 1,nuco2
+        do jl = 1,kdlon
+
+      ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) 
+     .                       * (-bsurf(jl,ja))
+
+c                                                        ksidb reciprocity
+c                                                        -----------------
+      ksidb(jl,ja,nlaylte+1,0) = - ksidb(jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   sum of band 1 and 2 of co2 contribution 
+c               ---------------------------------------
+
+      do i = 0,nlaylte+1
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            ksidb(jl,3,i,j)= ksidb(jl,1,i,j) + ksidb(jl,2,i,j)
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         3.0   Diffusion
+c               ---------
+
+      i = nlaylte+1
+      do jl = 1,kdlon
+        fluxdiff(jl,1,i)   = 0.
+        fluxdiff(jl,2,i)   = 0.
+      enddo
+
+      call lwdiff (kdlon,kflev
+     .         ,bsurf,btop,dbsublay
+     .         ,tautotal,omegtotal,gtotal
+     .         ,emis,fluxdiff)
+
+c----------------------------------------------------------------------
+c         4.0   Radiative Budget for each layer i
+c               ---------------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+            netrad(jl,i) = 0.
+        enddo
+      enddo
+
+      do i = 1,nlaylte
+        do j = 0,nlaylte+1
+          do jl = 1,kdlon
+
+            netrad(jl,i) = netrad(jl,i) + ksidb(jl,3,i,j)
+
+          enddo
+        enddo
+      enddo
+c                                                 diffusion contribution
+c                                                 ----------------------
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          netrad(jl,i) = netrad(jl,i) 
+     .                 - fluxdiff(jl,1,i+1) - fluxdiff(jl,2,i+1)   
+     .                 + fluxdiff(jl,1,i)   + fluxdiff(jl,2,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate for each layer i
+c               -----------------------------
+
+      do i = 1,nlaylte
+        do jl = 1,kdlon
+
+          coolrate(jl,i) = gcp * netrad(jl,i) / dp(jl,i)
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         5.0   downward flux (all layers --> ground): "fluxground" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxground(jl) = 0.
+      enddo
+
+      do i = 1,nlaylte
+        do ja = 1,nuco2
+          do jl = 1,kdlon
+
+      fluxground(jl) = fluxground(jl)
+     .               + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i))
+
+          enddo
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxground(jl) = fluxground(jl) - fluxdiff(jl,2,1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.0   outgoing flux (all layers --> space): "fluxtop" 
+c               ---------------------------------------------------
+
+      do jl = 1,kdlon
+          fluxtop(jl) = 0.
+      enddo
+
+      do i = 0,nlaylte
+        do jl = 1,kdlon
+           fluxtop(jl) = fluxtop(jl)- ksidb(jl,3,i,nlaylte+1)
+        enddo
+      enddo
+   
+      do jl = 1,kdlon
+        fluxtop(jl) = fluxtop(jl) + fluxdiff(jl,1,nlaylte+1)  
+      enddo
+
+c----------------------------------------------------------------------
+c         6.5 ONLY FOR DIAGNOSTIC : Compute IR flux in the atmosphere 
+c             -------------------
+c     The broadband fluxes (W.m-2) at every level  from surface level (l=1) 
+c     up the top of the  upper layer (here: l=nlaylte+1) are:
+c     upward : flw_up(ig1d,l)   ;   downward : flw_dn(ig1d,j) 
+c
+      computeflux = .false.
+
+      IF (computeflux) THEN  ! not used by the GCM only for diagnostic !
+c      upward flux 
+c      ~~~~~~~~~~~
+       do i = 0,nlaylte
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefu(jl,ja,i,j) =0.
+            do l=j,nlaylte+1 
+              coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_up(jl,j) = 0.
+           do ja = 1,nuco2
+             flw_up(jl,j)=flw_up(jl,j)+bsurf(jl,ja)*coefu(jl,ja,0,j)
+             do i=1,j-1
+              flw_up(jl,j)=flw_up(jl,j)+blay(jl,ja,i)*coefu(jl,ja,i,j) 
+             end do 
+           end do
+           flw_up(jl,j)=flw_up(jl,j) + fluxdiff(jl,1,j)
+        end do
+       end do
+
+c      downward flux
+c      ~~~~~~~~~~~~~
+       do i = 1,nlaylte+1
+        do j = 1,nlaylte+1
+         do ja = 1,nuco2
+          do jl = 1,kdlon
+            coefd(jl,ja,i,j) =0.
+            do l=0,j-1
+              coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i)
+            end do
+          enddo
+         enddo
+        enddo
+       enddo
+       do j = 1,nlaylte+1
+        do jl = 1,kdlon
+           flw_dn(jl,j) = 0.
+           do ja = 1,nuco2
+             do i=j,nlaylte
+              flw_dn(jl,j)=flw_dn(jl,j)+blay(jl,ja,i)*coefd(jl,ja,i,j) 
+             end do 
+           end do
+           flw_dn(jl,j)=flw_dn(jl,j) - fluxdiff(jl,2,j)
+        end do
+       end do
+      END IF
+
+c----------------------------------------------------------------------
+c         7.0   outputs Grads 2D
+c               ----------------
+
+c ig1d: point de la grille physique ou on veut faire la sortie
+c ig0+1:  point du decoupage de la grille physique
+
+c#ifdef undim
+      if (callg2d) then
+
+      ig1d = ngridmx/2 + 1
+c     ig1d = ngridmx
+
+      if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon)
+     .    .OR.  ngridmx.EQ.1   ) then
+
+          ig = ig1d-ig0
+        print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0
+
+c--------------------------------------------
+c   Ouverture de g2d.dat
+c--------------------------------------------
+      if (g2d_premier) then
+        open (47,file='g2d.dat'
+clmd     &       ,form='unformatted',access='direct',recl=4)
+     &        ,form='unformatted',access='direct',recl=1
+     &        ,status='unknown')
+        g2d_irec=0
+        g2d_appel=0
+        g2d_premier=.false.
+      endif
+        g2d_appel = g2d_appel+1
+
+c--------------------------------------------
+c   Sortie g2d des xi proches + distants 
+c--------------------------------------------
+cl                               if (nflev .NE. 500) then
+      do ja = 1,nuco2
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = xi(ig1d,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+cl                               endif
+
+c------------------------------------------------------
+c   Writeg2d des ksidb 
+c------------------------------------------------------
+      do ja = 1,nuco2
+c       ja=1
+        do j = 0,nlaylte+1
+          do i = 0,nlaylte+1
+            g2d_irec=g2d_irec+1
+            reel4 = ksidb(ig,ja,i,j)
+            write(47,rec=g2d_irec) reel4
+          enddo
+        enddo
+      enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = ksidb(ig,3,i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d dpsgcp
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            dpsgcp(i,j) = dp(ig,j) / gcp
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+c         dpsgcp(i,0) = 0.0002  ! (rapport ~ entre 1000 et 10000 pour le sol)
+          dpsgcp(i,0) = 1.      ! (pour regler l'echelle des sorties)
+          dpsgcp(i,nlaylte+1) = 0.
+        enddo
+
+c     print*
+c     print*,'gcp: ',gcp
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dp: ',dp(ig,i)
+c       enddo
+c     print*
+c       do i = 0 , nlaylte+1
+c     print*,i,'dpsgcp: ',dpsgcp(i,1)
+c       enddo
+  
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = dpsgcp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+c------------------------------------------------------
+c  Writeg2d temperature
+c------------------------------------------------------
+
+        do j = 1 , nlaylte
+          do i = 0 , nlaylte+1
+            temp(i,j) = tlay(ig,j)
+          enddo
+        enddo
+
+        do i = 0 , nlaylte+1
+          temp(i,0) = tlev(ig,1)+dt0(ig)     ! temperature surface
+          temp(i,nlaylte+1) = 0.               ! temperature espace  (=0)
+        enddo
+
+      do j = 0,nlaylte+1
+        do i = 0,nlaylte+1
+          g2d_irec=g2d_irec+1
+          reel4 = temp(i,j)
+          write(47,rec=g2d_irec) reel4
+        enddo
+      enddo
+
+        write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0
+        write(76,*) 'nlaylte', nlaylte
+        write(76,*) 'nflev', nflev
+        write(76,*) 'kdlon', kdlon
+        write(76,*) 'ndlo2', ndlo2
+        write(76,*) 'ndlon', ndlon
+      do ja=1,4
+        write(76,*) 'bsurf', ja, bsurf(ig,ja)
+        write(76,*) 'btop', ja, btop(ig,ja)
+
+        do j=1,nlaylte+1
+          write(76,*) 'blev', ja, j, blev(ig,ja,j)
+        enddo
+
+        do j=1,nlaylte
+          write(76,*) 'blay', ja, j, blay(ig,ja,j)
+        enddo
+
+        do j=1,2*nlaylte
+          write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j)
+        enddo
+      enddo
+
+      endif
+c************************************************************************
+c#endif 
+      endif  !   callg2d
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwi.F	(revision 46)
@@ -0,0 +1,220 @@
+      subroutine lwi (ig0,kdlon,kflev
+     .                ,psi,zdblay,pdp
+     .                ,newpcolc )
+
+
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "yomlw.h"
+ 
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C                             -   lwi    -    
+C
+C     PURPOSE:       Shema semi - implicite 
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+
+c************************************************************************
+c
+c        0.    Declarations
+c              ------------
+c
+c-------------------------------------------------------------------------
+c        0.1   Arguments
+c              ---------
+c
+ 
+      integer ig0,kdlon,kflev
+
+      real    psi(ndlo2,kflev)
+     .     ,  zdblay(ndlo2,nir,kflev)
+     .     ,  pdp(ndlo2,kflev)
+
+
+      real    newpcolc(ndlo2,kflev)
+
+c-------------------------------------------------------------------------
+c        0.2   local arrays
+c              ------------
+c
+      real    di(ndlon,nflev) 
+     .      , hi(ndlon,nflev) 
+     .      , bi(ndlon,nflev) 
+
+      real    ci(ndlon,nflev) 
+     .      , ai(ndlon,nflev) 
+      real    deltat
+
+      real   semit, denom
+
+      integer i, jl
+
+c************************************************************************
+c
+c        1.    Initialisations
+c              ---------------
+c
+c-----------------------------------------------------------------------
+ 
+        deltat = dtphys * iradia
+c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
+        semit = semi * deltat
+c       semi = 0.
+
+c       print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit
+c       print*,'g,cpp',g,cpp
+
+
+c************************************************************************
+c
+c        2.    
+c              ---------------
+c
+c-------------------------------------------------------------------------
+c        2.1   Calcul des di
+c              -------------
+c
+
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
+     .    ( xi(ig0+jl,1,i,nlaylte+1)
+     .    + xi(ig0+jl,1,i,i+1)
+     .    + xi(ig0+jl,1,i,i-1) )
+     .    *    zdblay(jl,1,i)
+     .  + ( xi(ig0+jl,2,i,nlaylte+1)
+     .    + xi(ig0+jl,2,i,i+1)
+     .    + xi(ig0+jl,2,i,i-1) )
+     .    *    zdblay(jl,2,i)
+     .     )
+c     -------------------
+        enddo
+      enddo
+
+c couche nlaylte
+c ------------
+c      , on enleve i,i+1 sinon on a 2 fois le cooling2space
+
+      do jl = 1 , kdlon
+c     -------------------
+      di(jl,nlaylte) =  1 + semit * (g / pdp(jl,nlaylte) / cpp) * (
+     .    ( xi(ig0+jl,1,nlaylte,nlaylte+1)
+     .    + xi(ig0+jl,1,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,1,nlaylte)
+     .  + ( xi(ig0+jl,2,nlaylte,nlaylte+1)
+     .    + xi(ig0+jl,2,nlaylte,nlaylte-1) )
+     .    *    zdblay(jl,2,nlaylte)
+     .     )
+c     -------------------
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.2   Calcul des hi
+c              -------------
+c
+
+      do i = 1 , nlaylte-1
+        do jl = 1 , kdlon
+c     -------------------
+      hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
+     .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)   
+     .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
+c     -------------------
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.3   Calcul des bi
+c              -------------
+c
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+c     -------------------
+      bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) * 
+     .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)   
+     .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
+c     -------------------
+        enddo
+      enddo
+
+
+c couche 1
+c --------
+c  tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de 
+c    la discontinuite de temperature au sol , on met  b1 = 0
+
+
+      do jl = 1 , kdlon
+        bi(jl,1) = 0 
+      enddo
+
+c-------------------------------------------------------------------------
+c        2.4   
+c              -------------
+c
+
+c couche nlaylte
+c ------------
+
+      do jl = 1 , kdlon
+c     -------------------
+      ci(jl,nlaylte) = (gcp * psi(jl,nlaylte) / pdp(jl,nlaylte))
+     .                   / di(jl,nlaylte)
+
+      ai(jl,nlaylte) = - bi(jl,nlaylte) / di(jl,nlaylte)
+c     -------------------
+      enddo
+
+
+
+      do i = nlaylte-1 , 1 , -1
+        do jl = 1 , kdlon
+c     -------------------
+      denom = di(jl,i) + hi(jl,i) * ai(jl,i+1)
+
+      ci(jl,i) = (  gcp * psi(jl,i) / pdp(jl,i)
+     .             - hi(jl,i) * ci(jl,i+1)  )  / denom
+ 
+      ai(jl,i) = -bi(jl,i) / denom
+c     -------------------
+        enddo
+      enddo
+
+
+c-------------------------------------------------------------------------
+c        2.5   
+c              -------------
+c
+
+c couche 1
+c -------
+      do jl = 1 , kdlon
+        newpcolc(jl,1) = ci(jl,1)
+      enddo
+
+
+      do i = 2 , nlaylte
+        do jl = 1 , kdlon
+           newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1)
+        enddo
+      enddo
+
+
+
+c-------------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwmain.F	(revision 46)
@@ -0,0 +1,206 @@
+       subroutine lwmain (ig0,icount,kdlon,kflev
+     .                   ,dp,dt0,emis
+     .                   ,plev,tlev,tlay,aerosol,coolrate
+     .                   ,fluxground,fluxtop
+     .                   ,netrad
+     &                   ,QIRsQREF3d,omegaIR3d,gIR3d)
+
+c----------------------------------------------------------------------
+c     LWMAIN     organizes the LTE longwave calculations
+c     for layer 1 to layer "nlaylte" (stored in  "yomlw.h")
+c----------------------------------------------------------------------
+
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "comg1d.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer icount
+      integer kdlon            ! part of ngrid
+      integer kflev            ! part of nlayer
+
+      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
+      real dt0 (ndlo2)              ! surface temperature discontinuity (K)
+      real emis (ndlo2)             ! surface emissivity
+      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
+      real tlev (ndlo2,kflev+1)     ! level temperature (K)
+      real tlay (ndlo2,kflev)       ! layer temperature (K)
+      real aerosol(ndlo2,kflev,naerkind)      !  aerosol extinction optical
+c                         depth at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+
+
+c                                                            outputs:
+c                                                            --------
+      real coolrate(ndlo2,kflev)      ! cooling rate (K/s)
+      real fluxground(ndlo2)          ! downward ground flux (W/m2)
+      real fluxtop(ndlo2)             ! outgoing upward flux (W/m2) ("OLR")
+      real netrad (ndlo2,kflev)       ! radiative budget (W/m2)
+c     Aerosol optical properties
+      REAL :: QIRsQREF3d(ndlo2,kflev,nir,naerkind)
+      REAL :: omegaIR3d(ndlo2,kflev,nir,naerkind)
+      REAL :: gIR3d(ndlo2,kflev,nir,naerkind)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      real aer_t (ndlon,nuco2,nflev+1)  ! transmission (aer)
+      real co2_u (ndlon,nuco2,nflev+1)  ! absorber amounts (co2)
+      real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2)
+
+      real bsurf (ndlon,nir)            ! surface spectral planck function
+      real btop (ndlon,nir)             ! top spectral planck function
+      real blev (ndlon,nir,nflev+1)     ! level   spectral planck function
+      real blay (ndlon,nir,nflev)       ! layer   spectral planck function
+      real dblay (ndlon,nir,nflev)      ! layer gradient spectral planck function
+      real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck function
+                                        ! in sub layers
+
+      real tautotal(ndlon,nflev,nir)  ! \   Total single scattering
+      real omegtotal(ndlon,nflev,nir) !  >  properties (Addition of the
+      real gtotal(ndlon,nflev,nir)    ! /   NAERKIND aerosols prop.)
+
+      real newcoolrate(ndlon,nflev) ! cooling rate (K/s) / with implicite scheme
+
+      integer jk,jkk,ja,jl
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      if (firstcall) then
+
+        firstcall = .false.
+
+        do jkk = 0 , nlaylte+1
+          do jk = 0 , nlaylte+1
+            do ja = 1 , nuco2
+              do jl = 1 , ngridmx
+                  xi (jl,ja,jk,jkk)=0.
+              enddo
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+c         1.0   planck function
+c               ---------------
+
+      call lwb ( kdlon, kflev, tlev, tlay, dt0
+     .         , bsurf, btop, blay, blev, dblay, dbsublay)
+
+c----------------------------------------------------------------------
+c         2.0   absorber amounts
+c               ----------------
+
+      call lwu ( kdlon, kflev
+     .         , dp, plev, tlay, aerosol
+     &         , QIRsQREF3d,omegaIR3d,gIR3d
+     .         , aer_t, co2_u, co2_up
+     .         , tautotal,omegtotal,gtotal)
+
+c----------------------------------------------------------------------
+c         3.0   transmission functions / exchange coefficiants
+c               ----------------------------------------------
+
+c                                                                distants
+c                                                                --------
+                    if( mod(icount-1,ilwd).eq.0) then
+
+c     print*, 'CALL of DISTANTS'
+      call lwxd ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              neighbours
+c                                                              ----------
+                    if( mod(icount-1,ilwn).eq.0) then
+
+c     print*, 'CALL of NEIGHBOURS'
+      call lwxn ( ig0, kdlon, kflev
+     .          , dp
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+c                                                              boundaries
+c                                                              ----------
+                    if( mod(icount-1,ilwb).eq.0) then
+
+c     print*, 'CALL of BOUNDARIES'
+      call lwxb ( ig0, kdlon, kflev, emis
+     .          , aer_t, co2_u, co2_up)
+
+                    endif
+
+c----------------------------------------------------------------------
+c         4.0   cooling rate
+c               ------------
+
+      call lwflux ( ig0, kdlon, kflev, dp
+     .            , bsurf, btop, blev, blay, dbsublay
+     .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
+     .            , emis
+     .            , tautotal,omegtotal,gtotal
+     .            , coolrate, fluxground, fluxtop
+     .            , netrad)
+
+c     do jk = 1, nlaylte
+c       print*,coolrate(1,jk)
+c     enddo
+      
+c       do jkk = 0 , nlaylte+1
+c         do jk = 0 , nlaylte+1
+c           do ja = 1 , nuco2
+c             do jl = 1 , ngridmx
+c      if (xi (jl,ja,jk,jkk) .LT. 0
+c    .       .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then
+c                 print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk)
+c      endif
+c             enddo
+c           enddo
+c         enddo
+c       enddo
+
+c----------------------------------------------------------------------
+c
+c          5.    shema semi-implicite  (lwi) 
+c                ---------------------------
+c
+c
+      call lwi (ig0,kdlon,kflev,netrad,dblay,dp
+     .          , newcoolrate)
+c
+c  Verif que   (X sol,space) + somme(X i,sol) = 1
+c
+      do jkk = 1 , nlaylte
+        do jl = 1 , kdlon
+c     print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk) 
+c    .  ,coolrate(jl,jkk)
+      coolrate(jl,jkk) = newcoolrate(jl,jkk)
+        enddo
+      enddo
+c
+c----------------------------------------------------------------------
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxb.F	(revision 46)
@@ -0,0 +1,220 @@
+      subroutine lwxb (ig0,kdlon,kflev
+     .                ,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXB   computes transmission function and exchange coefficients
+c                          for boundaries 
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c 
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |***|***|***|***|***|***|***| 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |***|   |   |   |   |   | 0 |***|
+c              |---|---|---|---|---|---|---|---|
+c     ...      |***|   |   |   |   | 0 |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      4       |***|   |   |   | 0 |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      3       |***|   |   | 0 |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      2       |***|   | 0 |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      1       |***| 0 |   |   |   |   |   |***|
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |***|***|***|***|***|***|***|  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1
+c             (ground)                    (space)
+c
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+ 
+#include "yomlw.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer kdlon          ! part of ngrid
+      integer kflev          ! part of nalyer
+
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,ig0
+
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+c                                          2 for ground(1) and space(2)
+      real trans (ndlon,nuco2,2,0:nflev+1)
+      real ksi (ndlon,nuco2,2,0:nflev+1)
+c                                                       only for space
+      real trans_emis (ndlon,nuco2,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1)
+
+c*************************************************************************
+c         1.0   Transmissions 
+c               -------------
+c----------------------------------------------------------------------
+c         1.1   Direct Transmission 
+c               -------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja)  = co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+c                                                                 ground
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            zu(jl,ja) =  co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+c                                                                 space
+c                                                                 -----
+      do jk = 1 , nlaylte+1
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+            zu(jl,ja) =   2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+            zup(jl,ja) =  2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+            zt_aer(jl,ja) = aer_t(jl,ja,1) 
+     .                    * aer_t(jl,ja,1)
+     .                    / aer_t(jl,ja,jk)
+
+          enddo
+        enddo
+
+        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+            trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+      enddo
+
+c*************************************************************************
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c-------------------------------------------------------------------------
+c        2.1    colling to space  (from layer 1,nlaylte toward "layer" nlaylte+1)
+c               ----------------
+
+
+      ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
+     .                - trans(jl,ja,2,jk)
+
+      ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
+     .                   - trans_emis(jl,ja,jk+1) 
+
+      xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) 
+     .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
+
+c-------------------------------------------------------------------------
+c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
+c               -------------------
+
+
+      ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) 
+     .                - trans(jl,ja,1,jk+1)
+
+      xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
+
+c-------------------------------------------------------------------------
+          enddo
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+c       2.3     echange ground-space  (from "layer" 0 toward "layer" nlaylte+1)
+c               ----------------------
+
+c Is not used because we use sigma T4 for the ground budget in physiq.F
+
+      do ja = 1 , nuco2
+        do jl = 1 , kdlon
+
+      ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) 
+      xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
+
+c                                                         ksi Reciprocity
+c                                                         ---------------
+      xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
+
+        enddo
+      enddo
+
+c-------------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxd.F	(revision 46)
@@ -0,0 +1,257 @@
+      subroutine lwxd (ig0,kdlon,kflev,emis
+     .                ,aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXD   computes transmission function and exchange coefficiants
+c                        for distant layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |***|***|***|***|   | 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |***|***|***|   | 0 |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |***|***|   | 0 |   |***|   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |***|   | 0 |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |   | 0 |   |   |***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |   |   |***|***|***|   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |***|***|***|***|   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon      ! part of ngrid
+      integer kflev      ! part of nalyer
+ 
+      real emis (ndlo2)                  ! surface emissivity
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,jkk,ndim
+      parameter(ndim = ndlon*nuco2*(nflev+2)*(nflev+2))
+
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real ksi (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real ksi_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans (ndlon,nuco2,0:nflev+1,0:nflev+1)
+      real trans_emis (ndlon,nuco2,0:nflev+1,0:nflev+1)
+
+c----------------------------------------------------------------------
+      call zerophys(ndim,ksi_emis)
+c----------------------------------------------------------------------
+c         1.0   Transmission functions
+c               ----------------------
+
+c----------------------------------------------------------------------
+c        1.1   Direct transmission 
+c              -------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jkk)
+              zup(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+              zt_aer(jl,ja)= aer_t(jl,ja,jk)
+     .                      /aer_t(jl,ja,jkk)
+
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jk,jkk) = zt_co2(jl,ja) * zt_aer(jl,ja)
+            enddo
+          enddo
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans(jl,ja,jkk,jk) = trans(jl,ja,jk,jkk) 
+c           if (trans(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+c           if (trans(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           trans(jl,ja,jk,jkk)=1
+c           print*,'trans bande',ja,jk,jkk,trans(jl,ja,jk,jkk)
+c           endif
+
+            enddo
+          enddo
+     
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         1.2   Transmission with reflexion
+c               ---------------------------
+
+      do jk = 1 , nlaylte+1
+        do jkk = jk , nlaylte+1
+
+      if (callemis) then
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+c                                                                   co2
+c                                                                   ---
+              zu(jl,ja)  = 2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
+     .                                         - co2_u(jl,ja,jkk)
+              zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
+     .                                         - co2_up(jl,ja,jkk)
+c                                                                   aer
+c                                                                   ---
+                zt_aer(jl,ja)  = aer_t(jl,ja,1)
+     .                         * aer_t(jl,ja,1)
+     .                         / aer_t(jl,ja,jk)
+     .                         / aer_t(jl,ja,jkk)
+            enddo
+          enddo
+
+          call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+c                                                            co2 and aer
+c                                                            -----------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = zt_co2(jl,ja)
+     .                                 * zt_aer(jl,ja)
+            enddo
+          enddo
+
+      else
+
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jk,jkk) = 1.
+            enddo
+          enddo
+
+      endif
+c                                                       trans reciprocity
+c                                                       -----------------
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+              trans_emis(jl,ja,jkk,jk) = trans_emis(jl,ja,jk,jkk)
+c         if (trans_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  trans_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'trans_emis bande',ja,jk,jkk,trans_emis(jl,ja,jk,jkk)
+c         endif
+            enddo
+          enddo
+
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.0   Exchange Coefficiants
+c               ---------------------
+
+      do jk = 1 , nlaylte-2
+        do jkk = jk+2 , nlaylte
+          do ja = 1 , nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk,jkk) = 
+     .            trans(jl,ja,jk+1,jkk)   - trans(jl,ja,jk,jkk)
+     .          - trans(jl,ja,jk+1,jkk+1) + trans(jl,ja,jk,jkk+1)
+
+      ksi_emis(jl,ja,jk,jkk) = 
+     .   trans_emis(jl,ja,jk,jkk)   - trans_emis(jl,ja,jk+1,jkk)
+     . - trans_emis(jl,ja,jk,jkk+1) + trans_emis(jl,ja,jk+1,jkk+1)
+
+c       if (ksi(jl,ja,jk,jkk) .LT. 0 ) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=0
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+c       if (ksi(jl,ja,jk,jkk) .GT. 1) then
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c           ksi(jl,ja,jk,jkk)=1
+c           print*,'ksi bande',ja,jk,jkk,ksi(jl,ja,jk,jkk)
+c       endif
+
+c       if (ksi_emis(jl,ja,jk,jkk) .LT. 0 
+c    .                .OR.  ksi_emis(jl,ja,jk,jkk) .GT. 1) then
+c     print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk)
+c       endif
+
+      xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk)
+     .      + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl))
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+      ksi(jl,ja,jkk,jk)      = ksi(jl,ja,jk,jkk)
+      ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk)
+      xi(ig0+jl,ja,jkk,jk)   = xi(ig0+jl,ja,jk,jkk)
+
+            enddo
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+c         2.1   Save xi_emis for neighbours (lwxn.F)
+c               -----------------------------------
+
+      do jk = 1 , nlaylte-1
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c     ksi_emis(jl,ja,jk,jk+1) = 
+c    .   trans_emis(jl,ja,jk,jk+1)   - trans_emis(jl,ja,jk+1,jk+1)
+c    . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2)
+
+      xi_emis(ig0+jl,ja,jk) =
+     .                 ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl))
+
+          enddo
+        enddo
+      enddo
+
+c----------------------------------------------------------------------
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/lwxn.F	(revision 46)
@@ -0,0 +1,389 @@
+      subroutine lwxn ( ig0,kdlon,kflev
+     .                , dp
+     .                , aer_t,co2_u,co2_up)
+
+c----------------------------------------------------------------------
+c     LWXN   computes transmission function and exchange coefficiants
+c                        for neighbours layers
+c                          (co2 / aerosols)
+c                       (bands 1 and 2 of co2) 
+c----------------------------------------------------------------------
+c  
+c              |---|---|---|---|---|---|---|---|
+c   kflev+1    |   |   |   |   |   |   |   | 0 |  (space)
+c              |---|---|---|---|---|---|---|---|
+c    kflev     |   |   |   |   |   |***| 0 |   |
+c              |---|---|---|---|---|---|---|---|
+c     ...      |   |   |   |   |***| 0 |***|   |
+c              |---|---|---|---|---|---|---|---|
+c      4       |   |   |   |***| 0 |***|   |   | 
+c              |---|---|---|---|---|---|---|---|
+c      3       |   |   |***| 0 |***|   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      2       |   |***| 0 |***|   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      1       |   | 0 |***|   |   |   |   |   |
+c              |---|---|---|---|---|---|---|---|
+c      0       | 0 |   |   |   |   |   |   |   |  (ground)
+c              |---|---|---|---|---|---|---|---|
+c                0   1   2   3   4  ...  k |k+1 
+c             (ground)                    (space)
+c  
+c  (*)  xi computed in this subroutine
+c----------------------------------------------------------------------
+c                                                                       
+c  *********************************************************** nj=1
+c
+c
+c                                       sublayer    1                  
+c
+c
+c                                ----------------------------- nj=2
+c
+c                                       sublayer    2                  
+c
+c    - - - -  LAYER j - - - - -  ----------------------------- nj=3
+c
+c                                       sublayer    3                  
+c                                ----------------------------- nj=4
+c                                       sublayer  ncouche                  
+c  *********************************************************** ni=nj=ncouche+1
+c                                       sublayer  ncouche                  
+c                                ----------------------------- ni=4
+c                                       sublayer    3                  
+c
+c    - - - -  LAYER i - - - - -  ----------------------------- ni=3
+c
+c                                       sublayer    2                  
+c                     
+c                                ----------------------------- ni=2
+c
+c
+c                                       sublayer    1                  
+c
+c
+c  *********************************************************** ni=1
+c                                                                       
+c-----------------------------------------------------------------------
+c ATTENTION AUX UNITES:
+c le facteur 10*g fait passer des kg m-2 aux g cm-2
+c-----------------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+ 
+#include "yomlw.h"
+#include "callkeys.h"
+
+c----------------------------------------------------------------------
+c         0.1   arguments
+c               ---------
+c                                                            inputs:
+c                                                            -------
+      integer ig0
+      integer kdlon     ! part of ngrid
+      integer kflev     ! part of nalyer
+
+      real dp (ndlo2,kflev)              ! layer pressure thickness (Pa)
+
+      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
+      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
+      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
+
+c----------------------------------------------------------------------
+c         0.2   local arrays
+c               ------------
+
+      integer ja,jl,jk,nlmd,ni,nj
+
+      integer nmax
+      parameter (nmax=50)               ! max: 50 sublayers
+
+      real cn (nmax), cb (nmax)
+
+      real zu_layer_i (ndlon,nuco2)
+      real zup_layer_i (ndlon,nuco2)
+      real zt_aer_layer_i (ndlon,nuco2)
+
+      real zu_layer_j (ndlon,nuco2)
+      real zup_layer_j (ndlon,nuco2)
+      real zt_aer_layer_j (ndlon,nuco2)
+
+      real zu (ndlon,nuco2)
+      real zup (ndlon,nuco2)
+      real zt_co2 (ndlon,nuco2)
+      real zt_aer (ndlon,nuco2)
+
+      real zu_i (ndlon,nuco2,nmax+1)
+      real zup_i (ndlon,nuco2,nmax+1)
+      real zu_j (ndlon,nuco2,nmax+1)
+      real zup_j (ndlon,nuco2,nmax+1)
+      real zt_aer_i (ndlon,nuco2,nmax+1)
+      real zt_aer_j (ndlon,nuco2,nmax+1)
+
+      real trans (ndlon,nuco2,nmax+1,nmax+1)
+      real ksi (ndlon,nuco2,nflev-1)
+
+c----------------------------------------------------------------------
+c         0.3   Initialisation
+c               --------------
+
+      jk=ncouche+1
+      do ja = 1 ,nuco2
+        do jl = 1 , kdlon
+          zu_i (jl,ja,jk) = 0.
+          zup_i (jl,ja,jk) = 0.
+          zu_j (jl,ja,jk) = 0.
+          zup_j (jl,ja,jk) = 0.
+          zt_aer_i (jl,ja,jk) = 1.
+          zt_aer_j (jl,ja,jk) = 1.
+        enddo
+      enddo
+
+      if (linear) then
+
+      do nlmd = 1 ,ncouche
+        cn(nlmd)=(1.0/ncouche)
+        cb(nlmd)=(ncouche-nlmd+0.5)/ncouche
+c       print*,nlmd,cb(nlmd),cn(nlmd)
+      enddo
+
+      else
+
+      do nlmd = 1 ,ncouche-1
+        cn(nlmd)=(1-alphan)*alphan**(nlmd-1)
+        cb(nlmd)=0.5*(1+alphan)*alphan**(nlmd-1)
+      enddo
+      cn(ncouche)=alphan**(ncouche-1)
+      cb(ncouche)=0.5*alphan**(ncouche-1)
+
+      endif
+
+c test
+      if (nmax .LT. ncouche) then
+        print*,'!!!!! ATTENTION !!!!! '
+        print*,'probleme dans lwxn.F'
+        print*,' nmax=',nmax,'  < ncouche=',ncouche
+        call exit(1)
+      endif
+
+c----------------------------------------------------------------------
+      do jk = 1 , nlaylte-1
+c----------------------------------------------------------------------
+c         1.0   (co2) amount and (aer) transmission for all sublayers  
+c               ----------------------------------------------------
+
+        do ja = 1 , nuco2
+          do jl = 1 , kdlon
+
+c                                                        layer i (down)
+c                                                        -------------
+      zu_layer_i(jl,ja) =  co2_u(jl,ja,jk)  - co2_u(jl,ja,jk+1)
+      zup_layer_i(jl,ja) = co2_up(jl,ja,jk) - co2_up(jl,ja,jk+1)
+      zt_aer_layer_i(jl,ja) = aer_t(jl,ja,jk)
+     .                       / aer_t(jl,ja,jk+1)
+                                  
+      do nlmd=1,ncouche
+        zu_i(jl,ja,nlmd)=cn(nlmd)*zu_layer_i(jl,ja)
+        zup_i(jl,ja,nlmd)=cn(nlmd)*zup_layer_i(jl,ja)
+        zt_aer_i(jl,ja,nlmd)=zt_aer_layer_i(jl,ja)**cn(nlmd)
+      enddo
+
+c                                                          layer j (up)
+c                                                          ------------
+      zu_layer_j(jl,ja) =  co2_u(jl,ja,jk+1)  - co2_u(jl,ja,jk+2)
+      zup_layer_j(jl,ja) = co2_up(jl,ja,jk+1) - co2_up(jl,ja,jk+2)
+      zt_aer_layer_j(jl,ja) = aer_t(jl,ja,jk+1)
+     .                       / aer_t(jl,ja,jk+2)
+        
+      do nlmd=1,ncouche
+        zu_j(jl,ja,nlmd)=cn(nlmd)*zu_layer_j(jl,ja)
+        zup_j(jl,ja,nlmd)=cn(nlmd)*zup_layer_j(jl,ja)
+        zt_aer_j(jl,ja,nlmd)=zt_aer_layer_j(jl,ja)**cn(nlmd)
+      enddo
+
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         2.0   transmissions between all sublayers
+c               ------------------------------------
+
+        do ni = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=ni,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_i(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_i(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_i(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+c on ajoute la couche J
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_j(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_j(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_j(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ni,1)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+        
+        do nj = 1 ,ncouche+1
+
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=0.    
+      zup(jl,ja)=0.    
+      zt_aer(jl,ja)=1.    
+                        
+      do nlmd=nj,ncouche+1
+        zu(jl,ja)=zu(jl,ja)+zu_j(jl,ja,nlmd)    
+        zup(jl,ja)=zup(jl,ja)+zup_j(jl,ja,nlmd)    
+        zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_j(jl,ja,nlmd)    
+      enddo
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+
+c on ajoute la couche I
+            do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+      zu(jl,ja)=zu(jl,ja)+zu_layer_i(jl,ja) 
+      zup(jl,ja)=zup(jl,ja)+zup_layer_i(jl,ja) 
+      zt_aer(jl,ja)=zt_aer(jl,ja)*zt_aer_layer_i(jl,ja) 
+              enddo
+            enddo
+                     
+      call lwtt(kdlon,zu,zup,nuco2,zt_co2)
+                         
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            trans(jl,ja,1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja)
+          enddo
+        enddo
+                   
+        enddo
+        
+c----------------------------------------------------------------------
+c         3.0   global exchange coefficiant between neigthbours
+c               -----------------------------------------------
+        
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            ksi(jl,ja,jk) = 0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ni+1,ncouche+1)
+     .             - trans(jl,ja,ni,ncouche+1)
+     .             - trans(jl,ja,ni+1,1)
+     .             + trans(jl,ja,ni,1) )
+     .             * (cb(ni)*dp(jl,jk)) * 2    
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do nj = 1 ,ncouche
+          do ja = 1 ,nuco2
+            do jl = 1 , kdlon
+
+      ksi(jl,ja,jk)=ksi(jl,ja,jk) +
+     .             ( trans(jl,ja,ncouche+1,nj+1)
+     .             - trans(jl,ja,1,nj+1)
+     .             - trans(jl,ja,ncouche+1,nj)
+     .             + trans(jl,ja,1,nj) )
+     .             * (cb(nj)*dp(jl,jk+1)) * 2 
+     .             /  (dp(jl,jk) + dp(jl,jk+1))       !!!!!!!!!!!!!!!!!!!
+
+            enddo
+          enddo
+        enddo
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk)
+     .                            + xi_emis(ig0+jl,ja,jk)
+
+c                                                        ksi reciprocity
+c                                                        ---------------
+            xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1)
+          enddo
+        enddo
+
+c----------------------------------------------------------------------
+c         4.0   Special treatment for ground
+c               ----------------------------
+
+
+      if (jk .EQ. 1) then
+
+        do ja = 1 ,nuco2
+          do jl = 1 , kdlon
+            xi_ground(ig0+jl,ja)=0.
+          enddo
+        enddo
+
+        do ni = 1 ,ncouche
+          do ja = 1 ,nuco2
+              do jl = 1 , kdlon
+
+      xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja)
+     .                     + ( trans(jl,ja,ni+1,ncouche+1)
+     .                        -trans(jl,ja,ni,ncouche+1))
+     .                     * 2 * cb(ni)
+            enddo
+          enddo
+        enddo
+
+      endif
+
+c----------------------------------------------------------------------
+      enddo    !  boucle sur jk
+c----------------------------------------------------------------------
+      return
+      end
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/swmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/swmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/splitting/swmain.F	(revision 46)
@@ -0,0 +1,189 @@
+      SUBROUTINE SWMAIN ( KDLON, KFLEV,
+     $                PCST, albedo,
+     $                PRMU0, PDP, PPLEV, aerosol,PFRACT,
+     $                PHEAT, PFLUXD,PFLUXU,
+     &                QVISsQREF3d,omegaVIS3d,gVIS3d)
+
+      IMPLICIT NONE
+      
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+#include "callkeys.h"
+c     
+c     PURPOSE.
+c     --------
+c     
+c     This routine computes the shortwave (solar wavelength)
+c     radiation fluxes in two spectral intervals 
+c     and heating rate on the first "nlaylte" layers.
+C     
+c     Francois Forget (2000), adapted from 
+C     Fouquart and Bonnel's ECMWF program
+c 
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    PCST  :  Solar constant on Mars (W.m-2)
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PRMU0 :         cos of solar zenith angle (=1 when sun at zenith)
+c    PDP :           Layer thickness (Pa)
+c    PPLEV           pressure (Pa) at boundaries of each layer 
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    Pfract :        day fraction of the time interval
+c                          =1 during the full day ; =0 during the night
+c    QVISsQREF3d,omegaVIS3d,gVIS3d Aerosol optical properties
+c
+C     ==== OUTPUTS ===
+c    PHEAT :         Heating rate (K/s)
+c    PFLUXD :        SW downward flux at boundaries of each layer (W.m-2)
+c    PFLUXU :        SW upward flux at boundaries of each layer (W.m-2)
+C     
+C     ----------
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+C     ARGUMENTS
+C     ---------
+      
+      INTEGER KDLON, KFLEV
+      REAL ZPSOL(NDLO2), aerosol(NDLO2,KFLEV,naerkind),PRMU0(NDLO2)
+      real PCST
+      REAL albedo(NDLO2,2)
+      REAL PDP(NDLO2,KFLEV)
+      REAL PPLEV(NDLO2,KFLEV+1)
+      REAL PHEAT(NDLO2,KFLEV)
+      REAL PFRACT(NDLO2)
+      real PFLUXD(NDLON,NFLEV+1,2)
+      real PFLUXU(NDLON,NFLEV+1,2)
+      REAL :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL :: gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      
+C     LOCAL ARRAYS
+C     ------------
+      
+      REAL ZDSIG(NDLON,NFLEV), ZFACT(NDLON)
+     S     ,  ZFD(NDLON,NFLEV+1)
+     S     ,  ZFU(NDLON,NFLEV+1)
+     S     ,  ZRMU(NDLON), ZSEC(NDLON)
+     S     ,  ZUD(NDLON,3,NFLEV+1), ZUM(NDLON,NFLEV+1)
+      REAL ZSIGN(NDLON),  ZSIGO(NDLON)
+
+c following line has been changed, kflev--->nflev (to avoid error message 
+c when compiling on NASA Ames Sun)
+      REAL ZFDOWN(NDLO2,NFLEV+1),ZFUP(NDLO2,NFLEV+1)
+
+      integer jl, jk, jkp1, jkl
+      integer INU 
+      real  zdfnet
+
+C     ------------------------------------------------------------------
+C     Initializations :
+C     ------------------------------------------------------------------
+
+c     Incident Solar flux and corrected angle in the atmosphere 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+c        Incident Flux at the top of the atmosphere
+         ZFACT(JL)= PRMU0(JL) * PCST * PFRACT(JL)
+
+c        Cos of solar zenith angle CORRECTED for high zenith angle
+       if (PRMU0(JL).GT.0) then
+         ZRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
+       else
+         ZRMU(JL)= 1. / 35.
+       endif
+         ZSEC(JL)=1./ZRMU(JL)
+      END DO
+
+c     Calcul of ZDSIG  (thickness of layers in sigma coordinates)
+c     ~~~~~~~~~~~~~~~
+      DO JL = 1 , KDLON
+         ZSIGO(JL) = 1.0
+         ZPSOL(JL) = PPLEV(JL,1)
+      END DO
+      DO JK = 1 , nlaylte
+         JKP1 = JK + 1
+         JKL = nlaylte+1 - JK
+         DO  JL = 1 , KDLON
+            ZSIGN(JL) = PPLEV(JL,JKP1) / PPLEV(JL,1)
+            ZDSIG(JL,JK) = ZSIGO(JL) - ZSIGN(JL)
+            ZSIGO(JL) = ZSIGN(JL)
+         END DO
+      END DO
+
+C------------------------------------------------------------------
+C          LOOP ON SPECTRAL INTERVAL in solar spectrum
+C------------------------------------------------------------------
+c  2 spectral interval in solar spectrum :
+c  - INU=1: between wavelength "long1vis" and "long2vis" set in dimradmars.h
+c  - INU=2: between wavelength "long2vis" and "long3vis" set in dimradmars.h
+
+      DO INU = 1,2
+
+! NB: swrtype is set in callkeys.h
+        if (swrtype.eq.1) then ! Fouquart
+          CALL SWR_FOUQUART( KDLON, kflev, INU
+     &     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &     ,  ZFD,ZFU )
+        else
+          if (swrtype.eq.2) then ! Toon
+            CALL SWR_TOON( KDLON, kflev, INU
+     &       ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &       ,  albedo,ZDSIG,ZPSOL,ZRMU,ZSEC
+     &       ,  ZFD,ZFU )
+          else
+            write(*,*) "swmain: invalid swrtype value !!"
+            stop
+          endif ! of if (swrtype.eq.2)
+        endif ! of if (swrtype.eq.1)
+        
+         DO JK = 1 , nlaylte+1
+            DO  JL = 1 , KDLON
+              PFLUXD(JL,JK,INU)=ZFD(JL,JK)*ZFACT(JL)
+              PFLUXU(JL,JK,INU)=ZFU(JL,JK)*ZFACT(JL)
+            END DO
+         END DO
+      END DO ! of DO INU=1,2
+
+C     ------------------------------------------------------
+C     HEATING RATES
+C     ------------------------------------------------------
+
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           wavelength integrated flux at every level:
+            ZFUP(JL,JK)= (PFLUXU(JL,JK,1)+ PFLUXU(JL,JK,2))
+            ZFDOWN(JL,JK)= (PFLUXD(JL,JK,1)+ PFLUXD(JL,JK,2))
+         END DO
+      END DO
+     
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZDFNET = ZFUP (JL,JK  ) - ZFDOWN(JL,JK  )
+     S              -ZFUP (JL,JK+1) + ZFDOWN(JL,JK+1)
+c           Heating rate
+            PHEAT(JL,JK) = gcp * ZDFNET / PDP(JL,JK)
+         END DO
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/statto.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/statto.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/statto.h	(revision 46)
@@ -0,0 +1,34 @@
+
+!  statto:
+!     This include file controls the production of statistics.
+!     Some variables could be set in a namelist, but it is easier to
+!     do it here since arrays can then be dimensioned using parameters
+!     and values shouldn't have to change too often.   SRL
+
+!     Calculate stats every istats physics timesteps, starting at first
+!     call.  If istats=0 then don't do statistics at all.  Check value
+!     if number of physics timesteps changes.
+	integer istats
+
+!     Calculate itime independent sums and sums of squares,
+!     example, istat=1,istime=1 gives a single time mean
+	integer, parameter :: istime=12
+
+!     Number of 2D and 3D variables on which to do statistics.
+	integer n2dvar, n3dvar
+	parameter (n2dvar = 8, n3dvar = 5)
+
+!     Units for writing stats header and data
+	integer usdata
+
+!     count tab to know the variable record
+        integer count(istime)
+
+!     Record of the number of stores made for each time.
+	integer nstore(istime)
+
+! Size of the "controle" array
+        integer, parameter :: cntrlsize=15
+
+!       common /sttcom/ dummy,nstore,istats,usdata
+        common /sttcom/ nstore,istats,usdata,count
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/suaer.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/suaer.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/suaer.F90	(revision 46)
@@ -0,0 +1,431 @@
+SUBROUTINE suaer
+IMPLICIT NONE
+!==================================================================
+!     Purpose.
+!     --------
+!     initialize yomaer, the common that contains the
+!     radiative characteristics of the aerosols
+!     
+!     AUTHORS.
+!     -------- 
+!     Richard Fournier (1996) Francois Forget (1996)
+!     Frederic Hourdin
+!     Jean-jacques morcrette *ECMWF*
+!     MODIF Francois Forget (2000)
+!     MODIF Franck Montmessin (add water ice)
+!     MODIF J.-B. Madeleine 2008W27
+!       - Optical properties read in ASCII files
+!       - Add varying radius of the particules
+!
+!    Summary.
+!    --------
+!
+!    Read the optical properties -> Mean  -> Variable assignment
+!                  (ASCII files)                  (see yomaer.h)
+!    wvl(nwvl)                      longsun
+!    ep(nwvl)                       epav     QVISsQREF(nsun)
+!    omeg(nwvl)                     omegav   omegavis(nsun)
+!    gfactor(nwvl)                  gav      gvis(nsun)
+!    
+!==================================================================
+
+! Includes:
+
+#include "callkeys.h"
+#include "datafile.h"
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"     
+#include "yomaer.h"
+
+! Optical properties (read in external ASCII files)
+INTEGER          :: nwvl     ! Number of wavelengths in
+                             ! the domain (VIS or IR)
+REAL, DIMENSION(:),&
+  ALLOCATABLE, SAVE :: wvl       ! Wavelength axis
+REAL, DIMENSION(:),&
+  ALLOCATABLE, SAVE :: radiusdyn ! Particle size axis
+
+REAL, DIMENSION(:,:),&
+  ALLOCATABLE, SAVE :: ep,&    ! Extinction coefficient Qext
+                       omeg,&  ! Single Scattering Albedo
+                       gfactor ! Assymetry Factor
+
+! Local variables:
+
+INTEGER :: iaer                ! Aerosol index
+INTEGER :: idomain             ! Domain index (1=VIS,2=IR)
+INTEGER :: iir                 ! IR channel index
+                               ! iir=1: 15um CO2 bands
+                               ! iir=2 : CO2 band wings
+                               ! iir=3 : 9 um band
+                               ! iir=4 : Far IR
+INTEGER :: isun                ! Solar band index
+INTEGER :: isize               ! Particle size index
+INTEGER :: jfile               ! ASCII file scan index
+INTEGER :: file_unit = 60
+LOGICAL :: file_ok, endwhile
+CHARACTER(LEN=132) :: scanline ! ASCII file scanning line
+
+! I/O  of "aerave" (subroutine averaging spectrally
+!   sing.scat.parameters)
+
+REAL tsun            ! Sun brightness temperature (for SW)
+REAL tsol            ! Surface reference brightness temp (LW)
+REAL longref         ! reference wavelengths
+REAL longsun(nsun+1) ! solar band boundaries
+REAL longir(nir+1)   ! IR band boundaries
+REAL epref           ! reference extinction ep
+                     ! at wavelength "longref"
+REAL epav(nir)       ! average ep
+                     ! (= <Qext>/Qext(longref) if epref=1)
+REAL omegav(nir)     ! Average sing.scat.albedo
+REAL gav(nir)        ! Average assymetry parameter
+
+! Local saved variables:
+
+CHARACTER(LEN=30), DIMENSION(naerkind,2), SAVE :: file_id
+!---- Please indicate the names of the optical property files below
+!     Please also choose the reference wavelengths of each aerosol
+!       naerkind=1, visible range:
+!       file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff       !!***WRF: pour faire varier le rayon (experim)
+        file_id(1,1) = 'optprop_dustvis_TM.dat'     !M.Wolff TM    !!***WRF: PAR DEFAUT 
+!       file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE   !!***WRF: pour test JB
+!       file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell
+!       file_id(1,1) = 'optprop_dustvis.dat'        !Clancy-Lee
+!       naerkind=1, infrared:
+!       file_id(1,2) = 'optprop_dustir_TM_n50.dat'  !M.Wolff
+        file_id(1,2) = 'optprop_dustir_TM.dat'      !M.Wolff
+!       file_id(1,2) = 'optprop_dustir_MW-MIE.dat'  !M.Wolff MIE
+!       file_id(1,2) = 'optprop_dustir_x0.5.dat'    !Toon-Forget
+!       naerkind=1, visible range:
+        longrefvis(1)=0.67E-6
+!                     For dust: change readtesassim accordingly;
+!       naerkind=1, infrared:
+        longrefir(1)=9.3E-6
+      IF (activice) THEN
+!       naerkind=2, visible range:
+        file_id(2,1) = 'optprop_icevis_n30.dat'
+!       file_id(2,1) = 'optprop_icevis.dat'
+!       naerkind=2, infrared:
+        file_id(2,2) = 'optprop_iceir_n30.dat'
+!       file_id(2,2) = 'optprop_iceir.dat'
+!       naerkind=2, visible range:
+        longrefvis(2)=1.5E-6  ! 1.5um OMEGA/MEx
+!       naerkind=2, infrared:
+        longrefir(2)=12.1E-6  ! 825cm-1 TES/MGS
+      ENDIF
+!------------------------------------------------------------------
+
+! Initializations:
+
+call zerophys(nsizemax*2*naerkind,radiustab)
+
+call zerophys(nsizemax*naerkind*nsun,gvis)
+call zerophys(nsizemax*naerkind*nsun,omegavis)
+call zerophys(nsizemax*naerkind*nsun,QVISsQREF)
+
+call zerophys(nsizemax*naerkind*nir,gIR)
+call zerophys(nsizemax*naerkind*nir,omegaIR)
+call zerophys(nsizemax*naerkind*nir,QIRsQREF)
+
+call zerophys(nsizemax*naerkind,QREFvis)
+call zerophys(nsizemax*naerkind,QREFir)
+call zerophys(nsizemax*naerkind,omegaREFvis)
+call zerophys(nsizemax*naerkind,omegaREFir)
+
+DO iaer = 1, naerkind ! Loop on aerosol kind
+  DO idomain = 1, 2   ! Loop on radiation domain (VIS or IR)
+!==================================================================
+! 1. READ OPTICAL PROPERTIES
+!==================================================================
+
+!       1.1 Open the ASCII file
+
+INQUIRE(FILE=datafile(1:LEN_TRIM(datafile))//&
+  '/'//file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+  EXIST=file_ok)
+IF(.NOT.file_ok) THEN
+  write(*,*)'Problem opening ',&
+    file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain)))
+  write(*,*)'It should be in: ',&
+    datafile(1:LEN_TRIM(datafile))
+  write(*,*)'1) You can change this directory address in '
+  write(*,*)' file phymars/datafile.h'
+  write(*,*)'2) If ',&
+    file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+    ' is a LMD reference datafile, it'
+  write(*,*)' can be obtained online on:'
+  write(*,*)' http://www.lmd.jussieu.fr/',&
+    '~forget/datagcm/datafile'
+  write(*,*)'3) If the name of the file is wrong, you can'
+  write(*,*)' change it in file phymars/suaer.F90. Just'
+  write(*,*)' modify the variable called file_id.'
+  CALL ABORT 
+ENDIF
+OPEN(UNIT=file_unit,&
+  FILE=datafile(1:LEN_TRIM(datafile))//&
+  '/'//file_id(iaer,idomain)(1:LEN_TRIM(file_id(iaer,idomain))),&
+  FORM='formatted')
+
+!       1.2 Allocate the optical property table
+
+jfile = 1
+endwhile = .false.
+DO WHILE (.NOT.endwhile)
+  READ(file_unit,*) scanline
+  IF ((scanline(1:1) .ne. '#').and.&
+    (scanline(1:1) .ne. ' ')) THEN
+    BACKSPACE(file_unit)
+    reading1_seq: SELECT CASE (jfile) ! ====================
+    CASE(1) reading1_seq ! nwvl ----------------------------
+        read(file_unit,*) nwvl
+        jfile = jfile+1
+    CASE(2) reading1_seq ! nsize ---------------------------
+        read(file_unit,*) nsize(iaer,idomain)
+        endwhile = .true.
+    CASE DEFAULT reading1_seq ! ---------------------------- 
+        WRITE(*,*) 'readoptprop: ',& 
+          'Error while loading optical properties.' 
+        CALL ABORT 
+    END SELECT reading1_seq ! ==============================
+  ENDIF
+ENDDO
+
+ALLOCATE(wvl(nwvl))                            ! wvl
+ALLOCATE(radiusdyn(nsize(iaer,idomain)))       ! radiusdyn
+ALLOCATE(ep(nwvl,nsize(iaer,idomain)))         ! ep
+ALLOCATE(omeg(nwvl,nsize(iaer,idomain)))       ! omeg 
+ALLOCATE(gfactor(nwvl,nsize(iaer,idomain)))    ! g
+
+!       1.3 Read the data
+
+jfile = 1
+endwhile = .false.
+DO WHILE (.NOT.endwhile)
+   READ(file_unit,*) scanline
+  IF ((scanline(1:1) .ne. '#').and.&
+    (scanline(1:1) .ne. ' ')) THEN
+    BACKSPACE(file_unit)
+    reading2_seq: SELECT CASE (jfile) ! ====================
+    CASE(1) reading2_seq ! wvl -----------------------------
+        read(file_unit,*) wvl
+        jfile = jfile+1
+    CASE(2) reading2_seq ! radiusdyn -----------------------
+        read(file_unit,*) radiusdyn
+        jfile = jfile+1
+    CASE(3) reading2_seq ! ep ------------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) ep(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        jfile = jfile+1
+    CASE(4) reading2_seq ! omeg ----------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) omeg(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        jfile = jfile+1
+    CASE(5) reading2_seq ! gfactor -------------------------
+        isize = 1
+        DO WHILE (isize .le. nsize(iaer,idomain))
+          READ(file_unit,*) scanline
+          IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+          BACKSPACE(file_unit)
+          read(file_unit,*) gfactor(:,isize)
+          isize = isize + 1
+          ENDIF
+        ENDDO
+        endwhile = .true.
+    CASE DEFAULT reading2_seq ! ----------------------------
+        WRITE(*,*) 'suaer.F90: ',&
+          'Error while loading optical properties.'
+        CALL ABORT
+    END SELECT reading2_seq ! ==============================
+  ENDIF
+ENDDO
+
+!       1.4 Close the file
+
+CLOSE(file_unit)
+
+!==================================================================
+! 2. AVERAGED PROPERTIES AND VARIABLE ASSIGNMENTS
+!==================================================================
+domain: SELECT CASE (idomain)
+!==================================================================
+CASE(1) domain !                   VISIBLE DOMAIN (idomain=1)
+!==================================================================
+
+! 2.1 Parameters
+  tsun=6000.E+0
+  longsun(1)=long1vis
+  longsun(2)=long2vis
+  longsun(3)=long3vis
+  longref=longrefvis(iaer)
+  epref=1.E+0
+
+DO isize=1,nsize(iaer,idomain)
+! ------------------------------------------------
+! 2.2 Save the particle sizes
+  radiustab(iaer,idomain,isize)=radiusdyn(isize)
+! 2.3 Averaged optical properties (GCM channels)
+! Notice: Aerave also computes the extinction coefficient and
+!   single scattering albedo at reference wavelength
+!   (called QREFvis and OMEGAREFvis, same in the IR,
+!   and not epref, which is a different parameter);
+!   Reference wavelengths are defined for each aerosol in
+!   dimradmars.h.
+
+  CALL aerave ( nwvl,&
+       wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+       longref,epref,tsun,&
+       nsun,longsun, epav,omegav,gav,&
+       QREFvis(iaer,isize),omegaREFvis(iaer,isize) )
+! 2.4 Variable assignements (declared by yomaer.h)
+  DO isun=1,nsun
+    QVISsQREF(isun,iaer,isize)=epav(isun)
+    gvis(isun,iaer,isize)=gav(isun)
+    omegavis(isun,iaer,isize)=omegav(isun)
+  END DO
+! 2.5 Output display
+  WRITE(*,*) 'Les donnees spectrales :'
+  WRITE(*,*) 'Solaire (SW) ---->'
+  WRITE(*,*) 'Aerosol number: ', iaer
+  WRITE(*,*) 'Rayon aerosol: ', radiustab(iaer,idomain,isize)
+  WRITE(*,*) '<Qext>/Qext(longrefvis) ; omega ; g'
+  DO isun=1,nsun
+    WRITE(*,*) QVISsQREF(isun,iaer,isize),&
+         omegavis(isun,iaer,isize),&
+         gvis(isun,iaer,isize)
+  ENDDO
+  WRITE(*,*) 'QREFvis(',iaer,isize,') = ',QREFvis(iaer,isize)
+  WRITE(*,*) 'omegaREFvis(',iaer,isize,') = ',&
+                                      omegaREFvis(iaer,isize)
+! ------------------------------------------------
+ENDDO
+
+!==================================================================
+CASE(2) domain !                  INFRARED DOMAIN (idomain=2)
+!==================================================================
+
+DO isize=1,nsize(iaer,idomain) ! ----------------------------------
+
+! 2.1 solsir is not used anymore; division of Qext(IR) by solsir
+!     has to be done in the input ASCII files (if necessary).
+
+! 2.2 Save the particle sizes
+  radiustab(iaer,idomain,isize)=radiusdyn(isize)
+
+! 2.3 Parameters
+
+  tsol=215.D+0
+  longir(1)=long1ir
+  longir(2)=long1co2
+  longir(3)=long2co2
+  longir(4)=long2ir
+  longref=longrefir(iaer)
+  epref=1.E+0
+
+! 2.4 Averaged optical properties (GCM channels)
+!           epav is <QIR>/Qext(longrefir) since epref=1
+! Notice: Aerave also Computes the extinction coefficient at
+!   reference wavelength (called QREFvis or QREFir,
+!   and not epref, which is a different parameter);
+!   Reference wavelengths are defined for each aerosol in
+!   dimradmars.h.
+
+  CALL aerave ( nwvl,&
+       wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+       longref,epref,tsol,&
+       nir-1,longir,epav,omegav,gav,&
+       QREFir(iaer,isize),omegaREFir(iaer,isize) )
+  WRITE(*,*) 'QREFir(',iaer,isize,') = ',QREFir(iaer,isize)
+  WRITE(*,*) 'omegaREFir(',iaer,isize,') = ',&
+                                      omegaREFir(iaer,isize)
+
+! 2.5 Computing  <QIR>/Qext(longrefvis)
+
+  DO iir=1,4
+    WRITE(*,*) 'QIRsQREFir Channel ',iir,': ',epav(iir)
+    epav(iir)=  epav(iir) * QREFir(iaer,isize) / &
+                            QREFvis(iaer,isize)
+  ENDDO
+  WRITE(*,*) 'Aerosol number', iaer
+  WRITE(*,*) 'Particle size: ',radiustab(iaer,idomain,isize)
+  WRITE(*,*) 'Rapport Solaire/IR:',&
+             QREFvis(iaer,isize) / QREFir(iaer,isize)
+
+! 2.6 Variable assignements
+!           (variables are declared by yomaer.h)
+
+!         Single scattering properties
+!           in each of the "nir" bands
+!           (cf. dimradmars.h)
+
+! iir=1 : central 15um CO2 bands   
+  QIRsQREF(1,iaer,isize)=epav(2)
+  omegaIR(1,iaer,isize)=omegav(2)
+  gIR(1,iaer,isize)=gav(2)
+
+! iir=2 : CO2 band wings
+!           (same properties than for central part)
+  QIRsQREF(2,iaer,isize)=epav(2)
+  omegaIR(2,iaer,isize)=omegav(2)
+  gIR(2,iaer,isize)=gav(2)
+
+! iir=3 : 9 um band [long1ir - long1co2]
+  QIRsQREF(3,iaer,isize)=epav(1)
+  omegaIR(3,iaer,isize)=omegav(1)
+  gIR(3,iaer,isize)=gav(1)
+
+! iir=4 : Far IR    [long2co2 - long2ir]
+  QIRsQREF(4,iaer,isize)=epav(3)
+  omegaIR(4,iaer,isize)=omegav(3)
+  gIR(4,iaer,isize)=gav(3)
+
+! 2.7 Output display
+
+  WRITE(*,*) 'AEROSOL PROPERTIES: Number ',iaer
+  WRITE(*,*) 'Thermal IR (LW) ---->'
+  WRITE(*,*) 'Particle size: ',radiustab(iaer,idomain,isize)
+  WRITE(*,*) '<Qext>/Qext(longrefvis) ; omega ; g'
+  DO iir=1,nir
+    WRITE(*,*) QIRsQREF(iir,iaer,isize),omegaIR(iir,iaer,isize),&
+         gIR(iir,iaer,isize)
+  ENDDO
+  WRITE(*,*) 'CO2: <Qabs>/Qext(longrefvis) = ',&
+       QIRsQREF(1,iaer,isize)*(1-omegaIR(1,iaer,isize))
+  WRITE(*,*) ''
+
+ENDDO ! isize (particle size) -------------------------------------
+
+END SELECT domain
+!==================================================================
+! 3. Deallocate temporary variables (read in ASCII files)
+!==================================================================
+
+DEALLOCATE(wvl)        ! wvl
+DEALLOCATE(radiusdyn)  ! radiusdyn
+DEALLOCATE(ep)         ! ep 
+DEALLOCATE(omeg)       ! omeg 
+DEALLOCATE(gfactor)    ! g
+
+  END DO ! Loop on iaer
+END DO   ! Loop on idomain
+!==================================================================
+RETURN
+END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/sulw.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/sulw.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/sulw.F	(revision 46)
@@ -0,0 +1,81 @@
+      SUBROUTINE SULW
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+#include "yomlw.h"
+C     
+C     PURPOSE.
+C     --------
+C     INITIALIZE YOMLW, THE COMMON THAT CONTAINS COEFFICIENTS
+C     NEEDED TO RUN THE LONGWAVE RADIATION ROUTINES
+C     
+C     AUTHOR.
+C     -------
+C     JEAN-JACQUES MORCRETTE  *ECMWF*
+c     Simplified F. Forget 01/2000
+C     
+C     ------------------------------------------------------------------
+C     ----------------------------------------------------------------
+C     
+C     *       1.    SET VALUES.
+C     -----------
+C     
+C     
+C--   REFERENCE TEMPERATURES FOR THE PLANCK FUNCTIONS ----- TSTAND
+C     TEMPERATURE DEPENDENCE OF THE ABSORPTION ----- TREF
+      DATA TSTAND,TREF / 200.0, 200.0 /
+C     
+C--   ROOTS AND WEIGHTS FOR THE 2-POINT GAUSSIAN QUADRATURE
+c     DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
+c     DATA (WG1(IG1),IG1=1,2) /  1.0        ,  1.0         /
+
+c-----------------------------------------------------------------------
+C--   COEFFICIENTS OF THE POLYNOMIALS GIVING THE PLANCK FUNCTIONS
+C     
+      DATA xp/
+
+     s     0.63849788E+01, 0.30969419E+02, 0.44790835E+02,
+     s     0.52651048E+01,-0.18799237E+02, 0.92836181E+01,
+
+     s     0.26166790E+02, 0.12348011E+03, 0.17868306E+03,
+     s     0.33657659E+02,-0.66869343E+02, 0.21017507E+02,
+c     
+c     s  0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+c     s -0.31971883E+02, 0.59168472E+01, 0.91927407E+01,
+c     
+c     s  0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+c     s  0.35582991E+03, 0.16958020E+03,-0.41311413E+02/
+c     
+     s     0.11101254E+02, 0.86037325E+02, 0.25892695E+03,
+     s     0.35582991E+03, 0.16958020E+03,-0.41311413E+02,
+
+     s     0.47045285E+02, 0.12234377E+03, 0.61873275E+02,
+     s     -0.31971883E+02, 0.59168472E+01, 0.91927407E+01/
+
+c     
+c-----------------------------------------------------------------------
+c     temperature dependency of absorber amounts:
+c     -------------------------------------------
+
+      DATA at
+     s     / 0.694E-03, 0.272E-02, 0.275E-02, 0.178E-01/
+      DATA bt
+     s     / 0.328E-05, 0.298E-05,-0.705E-04,-0.163E-04/
+
+c-----------------------------------------------------------------------
+      DATA (ga(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.170794E-01,-0.339714E-01, 0.000000E+00/
+      DATA (gb(ie, 1),ie=1,4)
+     s     / 0.288231E-04, 0.145426E-01, 0.543812E+00, 0.100000E+01/
+
+      DATA (ga(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.190634E+01, 0.384061E+01, 0.000000E+00/
+      DATA (gb(ie, 2),ie=1,4)
+     s     / 0.289299E-01, 0.189485E+01, 0.600363E+01, 0.100000E+01/
+
+      DATA cst_voigt / 0.500E-02, 0.100E-01, 0.150E-01, 0.100E+00/
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfdat.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfdat.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfdat.h	(revision 46)
@@ -0,0 +1,21 @@
+      COMMON/surfdat/albedodat(ngridmx),                                &
+     &   phisfi(ngridmx),albedice(2),emisice(2),emissiv,                &
+     &   TESice_Ncoef,TESice_Scoef,                                     &
+     &   iceradius(2) , dtemisice(2),                                   &
+     &   zmea(ngridmx),zstd(ngridmx),                                   &
+     &   zsig(ngridmx),zgam(ngridmx),zthe(ngridmx)
+
+      COMMON/surfdatl/TESicealbedo
+
+      real albedodat ! albedo of bare ground
+! Ehouarn: moved inertiedat to comsoil.h
+!      real inertiedat, ! thermal inertia
+      real phisfi ! geopotential at ground level
+      real albedice ! default albedo for ice (1: North H. 2: South H.)
+      real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+      real emissiv ! emissivity of bare ground
+      logical TESicealbedo ! use TES ice cap albedoes (if set to .true.)
+      real TESice_Ncoef ! coefficient for TES ice albedo in Northern hemisphere
+      real TESice_Scoef ! coefficient for TES ice albedo in Southern hemisphere
+      real iceradius , dtemisice
+      real zmea,zstd,zsig,zgam,zthe
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfini.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfini.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/surfini.F	(revision 46)
@@ -0,0 +1,67 @@
+      SUBROUTINE surfini(ngrid,piceco2,qsurf,psolaralb)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   creation des calottes pour l'etat initial
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "callkeys.h"
+#include "tracer.h"
+c
+      INTEGER ngrid,ig,icap
+      REAL  piceco2(ngrid),psolaralb(ngrid,2)
+      REAL qsurf(ngrid,nqmx) !tracer on surface (kg/m2)
+
+      EXTERNAL ISMIN,ISMAX
+      INTEGER ISMIN,ISMAX
+c
+c=======================================================================
+
+c
+c     calcul de piceco2 (kg/m2) a l'etat initial
+c     ------------------------------------------
+
+      DO 100 ig=1,ngrid
+         psolaralb(ig,1)=albedodat(ig)
+         psolaralb(ig,2)=albedodat(ig)
+100   CONTINUE
+
+      PRINT*,'minimum des donnees albedo',
+     s     albedodat(ISMIN(ngrid,albedodat,1))
+      PRINT*,'maximum des donnees albedo',
+     s     albedodat(ISMAX(ngrid,albedodat,1))
+c      calcul de psolaralb 
+c      -------------------
+      DO 115 ig=1,ngrid
+
+c	 IF (water) THEN 
+c	   if (qsurf(ig,nqmx).gt.0.005) then
+c             psolaralb(ig,1) = 0.4
+c             psolaralb(ig,2) = 0.4 
+c           endif 
+c         ENDIF
+c IF there is more than 5 pr. um of h2o ice but no C02 ice, surface albedo is set to 0.4. 
+         IF (piceco2(ig) .GT. 0.) THEN
+             IF(ig.GT.ngrid/2+1) THEN
+                icap=2
+             ELSE
+                icap=1
+             ENDIF
+             psolaralb(ig,1) = albedice(icap)
+             psolaralb(ig,2) =  albedice(icap)
+         END IF
+115   CONTINUE      
+
+      PRINT*,'minimum des donnees albedo',
+     s     psolaralb(ISMIN(ngrid,psolaralb,1),1)
+      PRINT*,'maximum des donnees albedo',
+     s     psolaralb(ISMAX(ngrid,psolaralb,1),1)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swmain.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swmain.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swmain.F	(revision 46)
@@ -0,0 +1,1 @@
+link splitting/swmain.F
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_fouquart.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_fouquart.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_fouquart.F	(revision 46)
@@ -0,0 +1,534 @@
+      SUBROUTINE SWR_FOUQUART ( KDLON, KFLEV, KNU
+     S     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,PDSIG,PPSOL,PRMU,PSEC
+     S     ,  PFD,PFU )
+
+      IMPLICIT NONE
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+C     
+C   SWR - Continuum scattering computations
+C     
+C     PURPOSE.
+C     --------
+C     Computes the reflectivity and transmissivity in case oF
+C     Continuum scattering
+c     F. Forget (1999)
+c
+c      BASED ON MORCRETTE EARTH MODEL
+C     (See radiation's part of the ecmwf research department
+C     documentation, and Fouquart and BonneL (1980)
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    KFLEV :  number of vertical layers
+c    KNU   :   Solar band # (1 or 2)
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PDSIG      layer thickness in sigma coordinates
+c    PPSOL       Surface pressure (Pa)
+c    PRMU:  cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c    PSEC   =1./PRMU
+
+C     ==== OUTPUTS ===
+c
+c    PFD : downward flux in spectral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+c    PFU : upward flux in specatral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+C
+C     
+C     METHOD.
+C     -------
+C     
+C     Computes continuum fluxes corresponding to aerosoL
+C     Or/and rayleigh scattering (no molecular gas absorption)
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+     
+C     ARGUMENTS
+C     ---------
+      INTEGER KDLON, KFLEV, KNU
+      REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2), 
+     S     PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
+
+      REAL QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)
+      REAL gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+
+      REAL PPSOL(NDLO2)
+      REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
+      REAL PRMU(NDLO2)
+
+C     LOCAL ARRAYS
+C     ------------
+ 
+      INTEGER jk,ja,jl,jae, jkl,jklp1,jkm1,jaj
+      REAL ZTRAY, ZRATIO,ZGAR, ZFF
+      real zfacoa,zcorae
+      real ZMUE, zgap,zbmu0, zww,zto,zden,zmu1,zbmu1,zden1,zre11
+
+      REAL ZC1I(NDLON,NFLEV+1), ZGG(NDLON), ZREF(NDLON)
+     S ,  ZRE1(NDLON), ZRE2(NDLON)
+     S ,  ZRMUZ(NDLON), ZRNEB(NDLON), ZR21(NDLON)
+     S ,  ZR23(NDLON),  ZSS1(NDLON), ZTO1(NDLON), ZTR(NDLON,2,NFLEV+1)
+     S ,  ZTR1(NDLON), ZTR2(NDLON), ZW(NDLON)
+
+      REAL ZRAY1(NDLO2,NFLEV+1), ZRAY2(NDLO2,NFLEV+1)
+     s   ,  ZREFZ(NDLO2,2,NFLEV+1)
+     S   ,  ZRMUE(NDLO2,NFLEV+1)
+     S   ,  ZCGAZ(NDLO2,NFLEV),ZPIZAZ(NDLO2,NFLEV),ZTAUAZ(NDLO2,NFLEV)
+
+      REAL  ZRAYL(NDLON)
+     S     ,   ZRJ(NDLON,6,NFLEV+1)
+     S     ,  ZRK(NDLON,6,NFLEV+1)
+     S     ,  ZTRA1(NDLON,NFLEV+1), ZTRA2(NDLON,NFLEV+1)
+
+c     Function
+c     --------
+      real CVMGT
+
+C    --------------------------------
+C     OPTICAL PARAMETERS FOR AEROSOLS 
+C     -------------------------------
+C     
+      DO  JK = 1 , nlaylte+1
+         DO  JA = 1 , 6
+            DO JL = 1 , KDLON
+               ZRJ(JL,JA,JK) = 0.
+               ZRK(JL,JA,JK) = 0.
+            END DO
+         END DO
+      END DO
+
+c Computing TOTAL single scattering parameters by adding
+c  properties of all the NAERKIND kind of aerosols
+
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZCGAZ(JL,JK) = 0.
+            ZPIZAZ(JL,JK) =  0.
+            ZTAUAZ(JL,JK) = 0.
+         END DO
+         DO 106 JAE=1,naerkind
+            DO 105 JL = 1 , KDLON
+c              Mean Extinction optical depth in the spectral band
+c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)
+     S              +aerosol(JL,JK,JAE)*QVISsQREF3d(JL,JK,KNU,JAE)
+c              Single scattering albedo
+c              ~~~~~~~~~~~~~~~~~~~~~~~~
+               ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)
+c              Assymetry factor
+c              ~~~~~~~~~~~~~~~~
+               ZCGAZ(JL,JK) =  ZCGAZ(JL,JK) +aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
+ 105        CONTINUE
+ 106     CONTINUE
+      END DO
+C     
+      DO JK = 1 , nlaylte
+         DO JL = 1 , KDLON
+            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
+     S            (ZPIZAZ(JL,JK).EQ.0) )
+            ZPIZAZ(JL,JK) = CVMGT( 1., ZPIZAZ(JL,JK) / ZTAUAZ(JL,JK),
+     S           (ZTAUAZ(JL,JK).EQ.0) )
+         END DO
+      END DO
+
+C     --------------------------------
+C     INCLUDING RAYLEIGH SCATERRING 
+C     -------------------------------
+      if (rayleigh) then 
+
+        call swrayleigh(kdlon,knu,ppsol,prmu,ZRAYL)
+
+c       Modifying mean aerosol parameters to account rayleigh scat by gas:
+
+        DO JK = 1 , nlaylte
+           DO JL = 1 , KDLON
+c             Rayleigh opacity in each layer :
+              ZTRAY = ZRAYL(JL) * PDSIG(JL,JK)
+c             ratio Tau(rayleigh) / Tau (total)
+              ZRATIO = ZTRAY / (ZTRAY + ZTAUAZ(JL,JK))
+              ZGAR = ZCGAZ(JL,JK)
+              ZFF = ZGAR * ZGAR
+                ZTAUAZ(JL,JK)=ZTRAY+ZTAUAZ(JL,JK)*(1.-ZPIZAZ(JL,JK)*ZFF)
+              ZCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
+              ZPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*ZPIZAZ(JL,JK)*(1.-ZFF)
+     S           / (1. -ZPIZAZ(JL,JK) * ZFF)
+           END DO
+        END DO
+      end if
+
+     
+C     ----------------------------------------------
+C     TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
+C     ----------------------------------------------
+C     
+ 200  CONTINUE
+      
+      DO JL = 1 , KDLON
+         ZR23(JL) = 0.
+         ZC1I(JL,nlaylte+1) = 0.
+      END DO
+      
+      DO JK = 1 , nlaylte
+         JKL = nlaylte+1 - JK
+         JKLP1 = JKL + 1
+         DO JL = 1 , KDLON
+            ZFACOA = 1.-ZPIZAZ(JL,JKL)*ZCGAZ(JL,JKL)*ZCGAZ(JL,JKL)
+            ZCORAE = ZFACOA * ZTAUAZ(JL,JKL) * PSEC(JL)
+            ZR21(JL) = EXP(-ZCORAE   )
+            ZSS1(JL) =  1.0-ZR21(JL)
+            ZC1I(JL,JKL) = 1.0-(1.0-ZSS1(JL))*(1.0-ZC1I(JL,JKLP1))
+         END DO
+      END DO
+
+C     -----------------------------------------------
+C     REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
+C     -----------------------------------------------
+C     
+      DO JL = 1 , KDLON
+         ZRAY1(JL,nlaylte+1) = 0.
+         ZRAY2(JL,nlaylte+1) = 0.
+         ZREFZ(JL,2,1) = albedo(JL,KNU)
+         ZREFZ(JL,1,1) = albedo(JL,KNU)
+         ZTRA1(JL,nlaylte+1) = 1.
+         ZTRA2(JL,nlaylte+1) = 1.
+      END DO
+
+      DO JK = 2 , nlaylte+1
+         JKM1 = JK-1
+         DO 342 JL = 1 , KDLON
+            ZRNEB(JL)= 1.e-5   ! used to be "cloudiness" (PCLDSW in Morcrette)
+
+            ZRE1(JL)=0.
+            ZTR1(JL)=0.
+            ZRE2(JL)=0.
+            ZTR2(JL)=0.
+      
+C           EQUIVALENT ZENITH ANGLE
+c           ~~~~~~~~~~~~~~~~~~~~~~~
+            ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL)
+     S           + ZC1I(JL,JK) * 1.66
+            ZRMUE(JL,JK) = 1./ZMUE
+
+C     ------------------------------------------------------------------
+C          REFLECT./TRANSMISSIVITY DUE TO AEROSOLS (and rayleigh ?)
+C     ------------------------------------------------------------------
+
+            ZGAP = ZCGAZ(JL,JKM1)
+            ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
+            ZWW =ZPIZAZ(JL,JKM1)
+            ZTO = ZTAUAZ(JL,JKM1)
+            ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
+     S           + (1-ZWW) * (1. - ZWW +2.*ZBMU0*ZWW)*ZTO*ZTO*ZMUE*ZMUE
+            ZRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
+            ZTRA1(JL,JKM1) = 1. / ZDEN
+C     
+            ZMU1 = 0.5
+            ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
+            ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
+     S         + (1-ZWW) * (1. - ZWW +2.*ZBMU1*ZWW)*ZTO*ZTO/ZMU1/ZMU1
+            ZRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
+            ZTRA2(JL,JKM1) = 1. / ZDEN1
+
+            ZGG(JL) =  ZCGAZ(JL,JKM1)
+            ZW(JL) =ZPIZAZ(JL,JKM1)
+            ZREF(JL) = ZREFZ(JL,1,JKM1)
+            ZRMUZ(JL) = ZRMUE(JL,JK)
+            ZTO1(JL) =  ZTAUAZ(JL,JKM1)/ZPIZAZ(JL,JKM1)
+
+ 342     CONTINUE
+
+C     
+         CALL DEDD ( KDLON
+     S        , ZGG,ZREF,ZRMUZ,ZTO1,ZW
+     S        , ZRE1,ZRE2,ZTR1,ZTR2     )
+C     
+         DO JL = 1 , KDLON
+C     
+            ZREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,1,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           + ZRNEB(JL) * ZRE2(JL)
+C     
+            ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (ZTRA1(JL,JKM1)
+     S           / (1.-ZRAY2(JL,JKM1)*ZREFZ(JL,1,JKM1)))
+     S           * (1.-ZRNEB(JL))
+C     
+            ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
+     S           + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)
+     S           * ZTRA2(JL,JKM1) )
+     S           + ZRNEB(JL) * ZRE1(JL)
+C     
+            ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)
+     S           + ZTRA1(JL,JKM1) * (1.-ZRNEB(JL))
+C     
+         END DO
+      END DO 
+C     
+C     
+C     ------------------------------------------------------------------
+C     
+C     *         3.5    REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
+C     -------------------------------------------------
+C     
+ 350  CONTINUE
+C     
+      IF (KNU.EQ.1) THEN
+         JAJ = 2
+         DO 351 JL = 1 , KDLON
+            ZRJ(JL,JAJ,nlaylte+1) = 1.
+            ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL, 1,nlaylte+1)
+ 351     CONTINUE
+C     
+         DO 353 JK = 1 , nlaylte
+            JKL = nlaylte+1 - JK
+            JKLP1 = JKL + 1
+            DO 352 JL = 1 , KDLON
+               ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,  1,JKL)
+               ZRJ(JL,JAJ,JKL) = ZRE11
+               ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,  1,JKL)
+ 352        CONTINUE
+ 353     CONTINUE
+ 354     CONTINUE
+C     
+      ELSE
+C     
+         DO 358 JAJ = 1 , 2
+            DO 355 JL = 1 , KDLON
+               ZRJ(JL,JAJ,nlaylte+1) = 1.
+               ZRK(JL,JAJ,nlaylte+1) = ZREFZ(JL,JAJ,nlaylte+1)
+ 355        CONTINUE
+C     
+            DO 357 JK = 1 , nlaylte
+               JKL = nlaylte+1 - JK
+               JKLP1 = JKL + 1
+               DO 356 JL = 1 , KDLON
+                  ZRE11= ZRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
+                  ZRJ(JL,JAJ,JKL) = ZRE11
+                  ZRK(JL,JAJ,JKL) = ZRE11 * ZREFZ(JL,JAJ,JKL)
+ 356           CONTINUE
+ 357        CONTINUE
+ 358     CONTINUE
+      END IF
+
+C     
+C     
+C     
+C     ------------------------------------------------------------------
+C     ---------------
+C     DOWNWARD FLUXES
+C     ---------------
+C    
+      JAJ = 2
+
+      do JK = 1 , nlaylte+1
+        JKL = nlaylte+1 - JK + 1
+        DO  JL = 1 , KDLON
+            PFD(JL,JKL) =   ZRJ(JL,JAJ,JKL) * sunfr(KNU)
+        end do
+      end do
+C    
+C  -------------
+C  UPWARD FLUXES
+C  -------------
+      DO JK = 1 , nlaylte+1
+         DO  JL = 1 , KDLON
+c           ZRK = upward flux / incident top flux
+            PFU(JL,JK) =    ZRK(JL,JAJ,JK) * sunfr(KNU)
+         END DO
+      END DO
+
+C     
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+     S                ,      PRE1,PRE2,PTR1,PTR2         )
+      implicit none
+C
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+C
+C**** *DEDD* - DELTA-EDDINGTON IN A CLOUDY LAYER
+C
+C     PURPOSE.
+C     --------
+C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
+C     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
+C
+C**   INTERFACE.
+C     ----------
+C          *DEDD* IS CALLED BY *SW*.
+C
+C     SUBROUTINE DEDD (KDLON,PGG,PREF,PRMUZ,PTO1,PW
+C    S                ,      PRE1,PRE2,PTR1,PTR2         )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C PGG    : (NDLON)             ; ASSYMETRY FACTOR
+C PREF   : (NDLON)             ; REFLECTIVITY OF THE UNDERLYING LAYER
+C PRMUZ  : (NDLON)             ; COSINE OF SOLAR ZENITH ANGLE
+C PTO1   : (NDLON)             ; OPTICAL THICKNESS
+C PW     : (NDLON)             ; SINGLE SCATTERING ALBEDO
+C     ==== OUTPUTS ===
+C PRE1   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR1   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING NO
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PRE2   : (NDLON)             ; LAYER REFLECTIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C PTR2   : (NDLON)             ; LAYER TRANSMISSIVITY ASSUMING
+C                              ; REFLECTION FROM UNDERLYING LAYER
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
+C
+C     EXTERNALS.
+C     ----------
+C
+C          NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
+C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL"
+C
+C     AUTHOR.
+C     -------
+C        JEAN-JACQUES MORCRETTE  *ECMWF*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 88-12-15
+C     ------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+      INTEGER KDLON
+C
+      REAL PGG(NDLO2),PREF(NDLO2),PRMUZ(NDLO2),PTO1(NDLO2),PW(NDLO2)
+      REAL PRE1(NDLO2),PRE2(NDLO2),PTR1(NDLO2),PTR2(NDLO2)
+
+c   local
+      integer jl
+      real*8 ZFF,ZGP,ZTOP,ZWCP,ZDT,ZX1,ZWM,ZRM2,ZRK,ZX2,ZRP,ZALPHA
+      real*8 ZBETA,ZEXMU0,ZEXKP,ZEXKM,ZXP2P,ZXM2P,ZAP2B,ZAM2B
+      real*8 ZA11,ZA12,ZA13,ZA22,ZA21,ZA23,ZDENA,ZC1A,ZC2A
+      real*8 ZRI0A,ZRI1A,ZRI0B,ZRI1B
+      real*8 ZB21,ZB22,ZB23,ZDENB,ZC1B,ZC2B
+      real*8 ZRI0C,ZRI1C,ZRI0D,ZRI1D
+C
+C     ------------------------------------------------------------------
+C
+C*         1.      DELTA-EDDINGTON CALCULATIONS
+C
+ 100  CONTINUE
+C
+      DO 131 JL   =   1 , KDLON
+C
+C*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
+C
+ 110  CONTINUE
+C
+      ZFF = PGG(JL)*PGG(JL)
+      ZGP = PGG(JL)/(1.+PGG(JL))
+      ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
+      ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
+      ZDT = 2./3.
+      ZX1 = 1.-ZWCP*ZGP
+      ZWM = 1.-ZWCP
+      ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
+      ZRK = SQRT(3.*ZWM*ZX1)
+      ZX2 = 4.*(1.-ZRK*ZRK*ZRM2)
+      ZRP = SQRT(3.*ZWM/ZX1)
+      ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2
+      ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2
+      ZEXMU0 = EXP(-ZTOP/ PRMUZ(JL) )
+      ZEXKP = EXP(ZRK*ZTOP)
+      ZEXKM = 1./ZEXKP
+      ZXP2P = 1.+ZDT*ZRP
+      ZXM2P = 1.-ZDT*ZRP
+      ZAP2B = ZALPHA+ZDT*ZBETA
+      ZAM2B = ZALPHA-ZDT*ZBETA
+C
+C*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
+C
+ 120  CONTINUE
+C
+      ZA11 = ZXP2P
+      ZA12 = ZXM2P
+      ZA13 = ZAP2B
+      ZA22 = ZXP2P*ZEXKP
+      ZA21 = ZXM2P*ZEXKM
+      ZA23 = ZAM2B*ZEXMU0
+      ZDENA = ZA11 * ZA22 - ZA21 * ZA12
+      ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
+      ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
+      ZRI0A = ZC1A+ZC2A-ZALPHA
+      ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
+      PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
+      ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
+      ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
+      PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
+C
+C*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
+C
+ 130  CONTINUE
+C
+      ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
+      ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
+      ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
+      ZDENB = ZA11 * ZB22 - ZB21 * ZA12
+      ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
+      ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
+      ZRI0C = ZC1B+ZC2B-ZALPHA
+      ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
+      PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
+      ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
+      ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
+      PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
+C
+ 131  CONTINUE
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_toon.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_toon.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swr_toon.F	(revision 46)
@@ -0,0 +1,529 @@
+      SUBROUTINE SWR_TOON ( KDLON, KFLEV, KNU
+     S     ,  aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d
+     &     ,  albedo,PDSIG,PPSOL,PRMU,PSEC
+     S     ,  PFD,PFU )
+
+      IMPLICIT NONE
+C     
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "callkeys.h"
+
+#include "yomaer.h"
+#include "yomlw.h"
+
+C     
+C   SWR - Continuum scattering computations
+C     
+C     PURPOSE.
+C     --------
+C     Computes the reflectivity and transmissivity in case oF
+C     Continuum scattering
+c     F. Forget (1999)
+c    
+c     Modified by Tran The Trung, using radiative transfer code 
+c     of Toon 1981.  
+C     
+C     IMPLICIT ARGUMENTS :
+C     --------------------
+C     
+C     ==== INPUTS ===
+c
+c    KDLON :  number of horizontal grid points
+c    KFLEV :  number of vertical layers
+c    KNU   :   Solar band # (1 or 2)
+c   aerosol               aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical properties.
+c    albedo   hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c    PDSIG      layer thickness in sigma coordinates
+c    PPSOL       Surface pressure (Pa)
+c    PRMU:  cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c    PSEC   =1./PRMU
+
+C     ==== OUTPUTS ===
+c
+c    PFD : downward flux in spectral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+c    PFU : upward flux in specatral band #INU in a given mesh
+c         (normalized to the total incident flux at the top of the atmosphere)
+C
+C     
+C     METHOD.
+C     -------
+C     
+C     Computes continuum fluxes corresponding to aerosoL
+C     Or/and rayleigh scattering (no molecular gas absorption)
+C     
+C-----------------------------------------------------------------------
+C     
+C     
+C-----------------------------------------------------------------------
+C     
+     
+C     ARGUMENTS
+C     ---------
+      INTEGER KDLON, KFLEV, KNU
+      REAL aerosol(NDLO2,KFLEV,naerkind), albedo(NDLO2,2), 
+     S     PDSIG(NDLO2,KFLEV),PSEC(NDLO2)
+
+      REAL QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind)  
+      REAL omegaVIS3d(NDLO2,KFLEV,nsun,naerkind)   
+      REAL gVIS3d(NDLO2,KFLEV,nsun,naerkind)
+
+      REAL PPSOL(NDLO2)
+      REAL PFD(NDLO2,KFLEV+1),PFU(NDLO2,KFLEV+1)
+      REAL PRMU(NDLO2)
+
+C     LOCAL ARRAYS
+C     ------------
+ 
+      INTEGER jk,jl,jae
+      REAL ZTRAY, ZRATIO,ZGAR, ZFF
+      REAL ZCGAZ(NDLO2,NFLEV),ZPIZAZ(NDLO2,NFLEV),ZTAUAZ(NDLO2,NFLEV)
+      REAL  ZRAYL(NDLON)
+
+c     Part added by Tran The Trung
+c     inputs to gfluxv 
+      REAL*8 DTDEL(nlaylte), WDEL(nlaylte), CDEL(nlaylte)
+c     outputs of gfluxv
+      REAL*8 FP(nlaylte+1), FM(nlaylte+1)      
+c     normalization of top downward flux
+      REAL*8 norm
+c     End part added by Tran The Trung
+
+c     Function
+c     --------
+      real CVMGT
+
+c Computing TOTAL single scattering parameters by adding
+c  properties of all the NAERKIND kind of aerosols
+
+      DO JK = 1 , nlaylte
+         DO  JL = 1 , KDLON
+            ZCGAZ(JL,JK) = 0.
+            ZPIZAZ(JL,JK) =  0.
+            ZTAUAZ(JL,JK) = 0.
+         END DO 
+         DO 106 JAE=1,naerkind
+            DO 105 JL = 1 , KDLON
+c              Mean Extinction optical depth in the spectral band
+c              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)
+     S              +aerosol(JL,JK,JAE)*QVISsQREF3d(JL,JK,KNU,JAE)
+c              Single scattering albedo
+c              ~~~~~~~~~~~~~~~~~~~~~~~~ 
+               ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)
+c              Assymetry factor
+c              ~~~~~~~~~~~~~~~~
+               ZCGAZ(JL,JK) =  ZCGAZ(JL,JK) +aerosol(JL,JK,JAE)*
+     S           QVISsQREF3d(JL,JK,KNU,JAE)*
+     &           omegaVIS3d(JL,JK,KNU,JAE)*gVIS3d(JL,JK,KNU,JAE)
+ 105        CONTINUE
+ 106     CONTINUE
+      END DO
+C     
+      DO JK = 1 , nlaylte
+         DO JL = 1 , KDLON
+            ZCGAZ(JL,JK) = CVMGT( 0., ZCGAZ(JL,JK) / ZPIZAZ(JL,JK),
+     S            (ZPIZAZ(JL,JK).EQ.0) )
+            ZPIZAZ(JL,JK) = CVMGT( 1., ZPIZAZ(JL,JK) / ZTAUAZ(JL,JK),
+     S           (ZTAUAZ(JL,JK).EQ.0) )
+         END DO
+      END DO
+
+C     --------------------------------
+C     INCLUDING RAYLEIGH SCATERRING 
+C     -------------------------------
+      if (rayleigh) then 
+
+        call swrayleigh(kdlon,knu,ppsol,prmu,ZRAYL)
+
+c       Modifying mean aerosol parameters to account rayleigh scat by gas:
+
+        DO JK = 1 , nlaylte
+           DO JL = 1 , KDLON
+c             Rayleigh opacity in each layer :
+              ZTRAY = ZRAYL(JL) * PDSIG(JL,JK)
+c             ratio Tau(rayleigh) / Tau (total)
+              ZRATIO = ZTRAY / (ZTRAY + ZTAUAZ(JL,JK))
+              ZGAR = ZCGAZ(JL,JK)
+              ZFF = ZGAR * ZGAR
+                ZTAUAZ(JL,JK)=ZTRAY+ZTAUAZ(JL,JK)*(1.-ZPIZAZ(JL,JK)*ZFF)
+              ZCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
+              ZPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*ZPIZAZ(JL,JK)*(1.-ZFF)
+     S           / (1. -ZPIZAZ(JL,JK) * ZFF)
+           END DO
+        END DO
+      end if
+
+c     Part added by Tran The Trung
+c     new radiative transfer
+
+      do JL = 1, KDLON
+
+c     assign temporary inputs
+        do JK = 1, nlaylte
+           jae = nlaylte+1-JK
+           DTDEL(JK) = real(ZTAUAZ(JL,jae),8)
+           WDEL(JK) = real(ZPIZAZ(JL,jae),8)
+           CDEL(JK) = real(ZCGAZ(JL,jae),8)
+        end do
+
+c     call gfluxv
+        call gfluxv(nlaylte, DTDEL,WDEL,CDEL,
+     S              real(PRMU(JL),8),
+     S              real(albedo(JL,KNU),8),
+     S              FP,FM)
+
+c     assign output
+        norm = FM(1)
+c     here we can have a check of norm not being 0.0
+c     however it would never happen in practice, 
+c     so we can comment out
+c        if (norm .gt. 0.0) then
+          do JK = 1, nlaylte+1
+             jae = nlaylte+2-JK
+             PFU(JL,JK) = sunfr(KNU)*real(FP(jae)/norm,4)
+             PFD(JL,JK) = sunfr(KNU)*real(FM(jae)/norm,4) 
+          end do
+c        elseif (norm .eq. 0.0) then
+c          do JK = 1, nlaylte+1
+c             PFU(JL,JK) = 0.0 
+c             PFD(JL,JK) = 0.0
+c          end do
+c        else
+c          stop "Error: top downward visible flux is negative!"
+c        end if
+ 
+      end do
+c     End part added by Tran The Trung
+
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE GFLUXV(NAYER,DTDEL,WDEL,CDEL,UBAR0,RSF
+     &                 ,FP,FM)
+      IMPLICIT NONE
+C  THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITONS
+C  FOR THE VISIBLE  FLUX AT ONE WAVELENGTH AND SOLVES FOR THE FLUXES AT
+C  THE LEVELS. THIS VERSION IS SET UP TO WORK WITH LAYER OPTICAL DEPTHS
+C  MEASURED FROM THE TOP OF EACH LAYER.  (DTAU) TOP OF EACH LAYER HAS
+C  OPTICAL DEPTH TAU(N). IN THIS SUB LEVEL N IS ABOVE LAYER N. THAT IS LAYER N
+C  HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES
+C  FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES.
+C  THIS SUBROUTINE DIFFERS FROM ITS IR CONTERPART IN THAT HERE WE SOLVE FOR
+C  THE FLUXES DIRECTLY USING THE GENERALIZED NOTATION OF MEADOR AND WEAVOR
+C  J.A.S., 37, 630-642, 1980.
+C  THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVER AND IS DOUBLE PRECISION SO MANY
+C  VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER
+
+C  THIS VERSION HAS BEEN MODIFIED BY TRAN THE TRUNG WITH:
+C   1. Simplified input & output for swr.F subroutine in LMDZ.MARS gcm model
+C   2. Use delta function to modify optical properties
+C   3. Use delta-eddington G1, G2, G3 parameters
+C   4. Optimized for speed
+
+C  INPUTS: 
+      INTEGER NAYER     
+c   NAYER = number of layer
+c            first layer is at top 
+c            last layer is at bottom
+      REAL*8 DTDEL(NAYER), WDEL(NAYER), CDEL(NAYER) 
+c   DTDEL = optical thickness of layer
+c   WDEL = single scattering of layer
+c   CDEL = assymetry parameter
+      REAL*8 UBAR0, RSF
+c   UBAR0 = absolute value of cosine of solar zenith angle
+c   RSF = surface albedo
+C  OUTPUTS:
+      REAL*8 FP(NAYER+1), FM(NAYER+1) 
+c   FP = flux up
+c   FM = flux down
+C  PRIVATES:
+      INTEGER J,NL,NLEV
+!!!! AS+JBM 03/2010 BUG BUG si trop niveaux verticaux (LES)
+!!!!                ET PAS BESOIN DE HARDWIRE SALE ICI  !   
+!!!! CORRIGER CE BUG AMELIORE EFFICACITE ET FLEXIBILITE      
+      !! PARAMETER (NL=201) 
+      !! C THIS VALUE (201) MUST BE .GE. 2*NAYER
+      REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4
+      !! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL)
+      !! REAL*8 LAMDA(NL),XK1(NL),XK2(NL)
+      !! REAL*8 G1(NL),G2(NL),G3(NL)
+      !! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL)
+      !! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL)
+      REAL*8 W0(2*NAYER), COSBAR(2*NAYER), DTAU(2*NAYER), TAU(2*NAYER)  
+      REAL*8 LAMDA(2*NAYER),XK1(2*NAYER),XK2(2*NAYER)
+      REAL*8 G1(2*NAYER),G2(2*NAYER),G3(2*NAYER)
+      REAL*8 GAMA(2*NAYER),CP(2*NAYER),CM(2*NAYER),CPM1(2*NAYER)
+      REAL*8 CMM1(2*NAYER)
+      REAL*8 E1(2*NAYER),E2(2*NAYER),E3(2*NAYER),E4(2*NAYER)
+
+      NL = 2*NAYER  !!! AS+JBM 03/2010 
+      NLEV = NAYER+1
+      
+C  TURN ON THE DELTA-FUNCTION IF REQUIRED HERE
+c      TAU(1) = 0.0
+c      DO J=1,NAYER
+c        W0(J)=WDEL(J)
+c        COSBAR(J)=CDEL(J)
+c        DTAU(J)=DTDEL(J)
+c        TAU(J+1)=TAU(J)+DTAU(J)
+c      END DO
+C  FOR THE DELTA FUNCTION  HERE...
+      TAU(1) = 0.0
+      DO J=1,NAYER
+        COSBAR(J)=CDEL(J)/(1.+CDEL(J))
+        W0(J)=1.-WDEL(J)*CDEL(J)**2
+        DTAU(J)=DTDEL(J)*W0(J)
+        W0(J)=WDEL(J)*(1.-CDEL(J)**2)/W0(J)
+        TAU(J+1)=TAU(J)+DTAU(J)
+      END DO
+      
+c     Optimization, this is the major speed gain 
+      TAU(1) = 1.0
+      do J = 2, NAYER+1
+        TAU(J) = EXP(-TAU(J)/UBAR0)
+      end do
+      BSURF = RSF*UBAR0*TAU(NLEV)
+C  WE GO WITH THE HEMISPHERIC CONSTANT APPROACH
+C  AS DEFINED BY M&W - THIS IS THE WAY THE IR IS DONE
+      DO J=1,NAYER
+c        Optimization: ALPHA not used 
+c        ALPHA(J)=SQRT( (1.-W0(J))/(1.-W0(J)*COSBAR(J)) )
+C  SET OF CONSTANTS DETERMINED BY DOM
+c      G1(J)= (SQRT(3.)*0.5)*(2. - W0(J)*(1.+COSBAR(J)))
+c      G2(J)= (SQRT(3.)*W0(J)*0.5)*(1.-COSBAR(J))
+c      G3(J)=0.5*(1.-SQRT(3.)*COSBAR(J)*UBAR0)
+c  We use delta-Eddington instead
+        G1(J)=0.25*(7.-W0(j)*(4.+3*cosbar(j)))
+        G2(J)=-0.25*(1.-W0(j)*(4.-3*cosbar(j)))
+        G3(J)=0.5*(1.-SQRT(3.)*COSBAR(J)*UBAR0)
+        LAMDA(J)=SQRT(G1(J)**2 - G2(J)**2)
+        GAMA(J)=(G1(J)-LAMDA(J))/G2(J)
+      END DO 
+
+      DO J=1,NAYER
+        G4=1.-G3(J)
+        DENOM=LAMDA(J)**2 - 1./UBAR0**2
+C  NOTE THAT THE ALGORITHM DONOT ACCEPT UBAR0 .eq. 0
+C  THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C  THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN
+C  THE SCATTERING GOES TO ZERO
+C  PREVENT THIS WITH AN IF STATEMENT
+        IF ( DENOM .EQ. 0.) THEN
+          DENOM=1.E-6
+        END IF
+        DENOM = W0(J)/DENOM
+        AM=DENOM*(G4   *(G1(J)+1./UBAR0) +G2(J)*G3(J) )
+        AP=DENOM*(G3(J)*(G1(J)-1./UBAR0) +G2(J)*G4    )
+C  CPM1 AND CMM1 ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C  AT THE TOP OF THE LAYER, THAT IS LOWER OPTICAL DEPTH TAU(J)
+        CPM1(J)=AP*TAU(J)
+        CMM1(J)=AM*TAU(J)
+C  CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C  BOTTOM OF THE LAYER. THAT IS AT HIGHER OPTICAL DEPTH TAU(J+1)
+        CP(J)=AP*TAU(J+1)
+        CM(J)=AM*TAU(J+1)
+      END DO
+
+C  NOW CALCULATE THE EXPONENTIAL TERMS NEEDED
+C  FOR THE TRIDIAGONAL ROTATED LAYERED METHOD
+C  WARNING IF DTAU(J) IS GREATER THAN ABOUT 35
+C  WE CLIPP IT TO AVOID OVERFLOW.
+C  EXP (TAU) - EXP(-TAU) WILL BE NONSENSE THIS IS
+C  CORRECTED IN THE DSOLVER ROUTINE. ??FLAG?
+      DO J=1,NAYER
+c        EXPTRM(J) = MIN(35.,LAMDA(J)*DTAU(J))
+        EP=EXP(MIN(35.0_8,LAMDA(J)*DTAU(J)))
+        EM=1.0/EP
+        AM = GAMA(J)*EM
+        E1(J)=EP+AM
+        E2(J)=EP-AM
+        AP = GAMA(J)*EP
+        E3(J)=AP+EM
+        E4(J)=AP-EM
+      END DO
+
+      CALL DSOLVER(NAYER,GAMA,CP,CM,CPM1,CMM1
+     &            ,E1,E2,E3,E4,0.0_8,BSURF,RSF,XK1,XK2)
+
+C  EVALUATE THE NAYER FLUXES THROUGH THE NAYER LAYERS
+C  USE THE TOP (TAU=0) OPTICAL DEPTH EXPRESSIONS TO EVALUATE FP AND FM
+C  AT THE THE TOP OF EACH LAYER,J = LEVEL J
+      DO J=1,NAYER
+        FP(J)= XK1(J) + GAMA(J)*XK2(J) + CPM1(J)
+        FM(J)= GAMA(J)*XK1(J) + XK2(J) + CMM1(J)
+      END DO
+
+C  USE EXPRESSION FOR BOTTOM FLUX TO GET THE FP AND FM AT NLEV
+c     Optimization: no need this step since result of last
+c     loop at about EP above give this
+c      EP=EXP(EXPTRM(NAYER))
+c      EM=1.0/EP
+      FP(NLEV)=XK1(NAYER)*EP + XK2(NAYER)*AM + CP(NAYER)
+      FM(NLEV)=XK1(NAYER)*AP + XK2(NAYER)*EM + CM(NAYER)
+
+C  ADD THE DIRECT FLUX TERM TO THE DOWNWELLING RADIATION, LIOU 182
+      DO J=1,NLEV
+        FM(J)=FM(J)+UBAR0*TAU(J)
+      END DO
+
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,
+     *                   BSURF,RSF,XK1,XK2)
+
+C DOUBLE PRECISION VERSION OF SOLVER
+
+cc      PARAMETER (NMAX=201)
+cc AS+JBM 03/2010
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
+     *          XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
+cc AS+JBM 03/2010      
+cc      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
+      DIMENSION AF(2*NL),BF(2*NL),CF(2*NL),DF(2*NL),XK(2*NL)
+
+C*********************************************************
+C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
+C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
+C* NO ASSUMPTION OF THE DEPENDENCE ON OPTICAL DEPTH OF   *
+C* C-PLUS OR C-MINUS HAS BEEN MADE.                      *
+C* NL     = NUMBER OF LAYERS IN THE MODEL                *
+C* CP     = C-PLUS EVALUATED AT TAO=0 (TOP)              *
+C* CM     = C-MINUS EVALUATED AT TAO=0 (TOP)             *
+C* CPM1   = C-PLUS  EVALUATED AT TAOSTAR (BOTTOM)        *
+C* CMM1   = C-MINUS EVALUATED AT TAOSTAR (BOTTOM)        *
+C* EP     = EXP(LAMDA*DTAU)                              *
+C* EM     = 1/EP                                         *
+C* E1     = EP + GAMA *EM                                *
+C* E2     = EP - GAMA *EM                                *
+C* E3     = GAMA*EP + EM                                 *
+C* E4     = GAMA*EP - EM                                 *
+C* BTOP   = THE DIFFUSE RADIATION INTO THE MODEL AT TOP  *
+C* BSURF  = THE DIFFUSE RADIATION INTO THE MODEL AT      *
+C*          THE BOTTOM: INCLUDES EMMISION AND REFLECTION *
+C*          OF THE UNATTENUATED PORTION OF THE DIRECT    *
+C*          BEAM. BSTAR+RSF*FO*EXP(-TAOSTAR/U0)          *
+C* RSF    = REFLECTIVITY OF THE SURFACE                  *
+C* XK1    = COEFFICIENT OF THE POSITIVE EXP TERM         *
+C* XK2    = COEFFICIENT OF THE NEGATIVE EXP TERM         *
+C*********************************************************
+C THIS ROUTINE CALLS ROUTINE DTRIDGL TO SOLVE TRIDIAGONAL
+C SYSTEMS
+C======================================================================C
+
+      L=2*NL
+ 
+C     ************MIXED COEFFICENTS**********
+C     THIS VERSION AVOIDS SINGULARITIES ASSOC.
+C     WITH W0=0 BY SOLVING FOR XK1+XK2, AND XK1-XK2.
+
+      AF(1) = 0.0
+      BF(1) = GAMA(1)+1.
+      CF(1) = GAMA(1)-1.
+      DF(1) = BTOP-CMM1(1)
+      N     = 0
+      LM2   = L-2
+
+C     EVEN TERMS
+ 
+      DO I=2,LM2,2
+        N     = N+1
+        AF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)       
+        BF(I) = (E2(N)+E4(N))*(GAMA(N+1)-1.)
+        CF(I) = 2.0*(1.-GAMA(N+1)**2)
+        DF(I) = (GAMA(N+1)-1.) * (CPM1(N+1) - CP(N)) +
+     *            (1.-GAMA(N+1))* (CM(N)-CMM1(N+1))
+      END DO
+ 
+      N   = 0
+      LM1 = L-1
+      DO I=3,LM1,2
+        N     = N+1
+        AF(I) = 2.0*(1.-GAMA(N)**2)
+        BF(I) = (E1(N)-E3(N))*(1.+GAMA(N+1))
+        CF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)
+        DF(I) = E3(N)*(CPM1(N+1) - CP(N)) + E1(N)*(CM(N) - CMM1(N+1))
+      END DO
+ 
+      AF(L) = E1(NL)-RSF*E3(NL)
+      BF(L) = E2(NL)-RSF*E4(NL)
+      CF(L) = 0.0
+      DF(L) = BSURF-CP(NL)+RSF*CM(NL)
+ 
+      CALL DTRIDGL(L,AF,BF,CF,DF,XK)
+ 
+C     ***UNMIX THE COEFFICIENTS****
+
+      DO 28 N=1,NL
+        XK1(N) = XK(2*N-1)+XK(2*N)
+        XK2(N) = XK(2*N-1)-XK(2*N)
+
+C       NOW TEST TO SEE IF XK2 IS REALLY ZERO TO THE LIMIT OF THE
+C       MACHINE ACCURACY  = 1 .E -30
+C       XK2 IS THE COEFFICIENT OF THE GROWING EXPONENTIAL AND MUST
+C       BE TREATED CAREFULLY
+
+        IF(XK2(N) .EQ. 0.0) GO TO 28
+        IF (ABS (XK2(N)/XK(2*N-1)) .LT. 1.E-30) XK2(N)=0.0
+
+   28 CONTINUE
+ 
+      RETURN
+      END
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+
+C     DOUBLE PRECISION VERSION OF TRIDGL
+
+cc AS+JBM 03/2010 : OBSOLETE MAINTENANT      
+cc      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+cc AS+JBM 03/2010 : OBSOLETE MAINTENANT
+cc      DIMENSION AS(NMAX),DS(NMAX)
+      DIMENSION AS(L),DS(L)
+
+C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*    A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C*    WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+
+C======================================================================C
+
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+
+      DO I=2,L
+        X         = 1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+        AS(L+1-I) = AF(L+1-I)*X
+        DS(L+1-I) = (DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+      END DO
+ 
+      XK(1)=DS(1)
+      DO I=2,L
+        XK(I) = DS(I)-AS(I)*XK(I-1)
+      END DO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swrayleigh.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swrayleigh.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/swrayleigh.F	(revision 46)
@@ -0,0 +1,86 @@
+      SUBROUTINE swrayleigh(kdlon,knu,ppsol,prmu,prayl)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing total rayleigh scat atmospheric optical depth  
+c
+c   author: F.Forget 
+c   ------
+c
+c   input:
+c   ----- 
+c   kdlon             Number of gridpoint of horizontal grid
+c    knu   :   Solar band # (1 or 2)
+c   ppsol             surface pressure (Pa) 
+c   prmu         cos of solar zenith angle (=1 when sun at zenith)
+c           (CORRECTED for high zenith angle (atmosphere), unlike mu0)
+c
+c   output:
+c   -------
+c   prayl       column optical depth in each model column
+c
+c=======================================================================
+#include "comcstfi.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER kdlon, knu
+
+      real ppsol(kdlon),prmu(kdlon),prayl(kdlon)
+c
+c    Local variables :
+c    -----------------
+      integer JL, K
+c
+c   local saved variables
+c   ---------------------
+c     rayleigh scattering coefficients (from Morcrete et al.EARTH model !)
+      real cray(2,6)
+
+      DATA (CRAY(1,K),K=1,6) /
+     S     .428937E-01, .890743E+00,-.288555E+01,
+     S     .522744E+01,-.469173E+01, .161645E+01/
+
+      DATA (CRAY(2,K),K=1,6) /
+     S     .697200E-02, .173297E-01,-.850903E-01,
+     S     .248261E+00,-.302031E+00, .129662E+00/
+      save cray
+c----------------------------------------------------------------------
+
+      DO JL = 1 , KDLON
+
+c        Total Rayleigh Optical thickness on Earth at 101325 Pa level
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c        WARNING : the CRAY coefficients are only valid for
+c        Spectral interval used in Earth model !!!
+c        (i.e. 0.25-0.68 micron and 0.68-4.00 micron
+c         ---> should be modified for Mars model !!!
+
+         PRAYL(JL) = CRAY(KNU,1) + PRMU(JL) * (CRAY(KNU,2) + PRMU(JL)
+     S        * (CRAY(KNU,3) + PRMU(JL) * (CRAY(KNU,4) + PRMU(JL)
+     S        * (CRAY(KNU,5) + PRMU(JL) *   CRAY(KNU,6)       ))))
+
+c        Total local Rayleigh Optical thickness on Mars
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c           - PRAYL above is the total Rayleigh Optical thickness
+c             at  101325Pa for Earth atmosphere
+c           -> Total Rayleigh Optical thickness on Mars
+c              = PRAYL*(Psurf/101325)*9.81/g *2.5
+c              (Extinction coeff of CO2 = 2.5 * N2)
+
+c     (Comment the following line to get back bugged version before 01/2000)
+c        PRAYL(JL) = PRAYL(JL) * PPSOL(JL) * 2.42e-4/g
+
+      END DO
+
+
+      return
+      end 
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tabfi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tabfi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tabfi.F	(revision 46)
@@ -0,0 +1,532 @@
+c=======================================================================
+      SUBROUTINE tabfi(nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .                 p_omeg,p_g,p_mugaz,p_daysec,time)
+c=======================================================================
+c
+c   C. Hourdin 15/11/96
+c
+c   Object:        Lecture du tab_cntrl physique dans un fichier 
+c   ------            et initialisation des constantes physiques
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c      - nid:    unitne logique du fichier ou on va lire le tab_cntrl    
+c                      (ouvert dans le programme appellant) 
+c
+c                 si nid=0:
+c                       pas de lecture du tab_cntrl mais
+c                       Valeurs par default des constantes physiques
+c        
+c      - tab0:    Offset de tab_cntrl a partir duquel sont ranges 
+c                  les parametres physiques (50 pour start_archive)
+c
+c      - Lmodif:  si on souhaite modifier les constantes  Lmodif = 1 = TRUE
+c
+c
+c     Outputs:
+c     --------
+c
+c      - day_ini: tab_cntrl(tab0+3) (Dans les cas ou l'on souhaite
+c                              comparer avec le day_ini dynamique)
+c
+c      - lmax:    tab_cntrl(tab0+2) (pour test avec nlayermx)
+c
+c      - p_rad
+c      - p_omeg   !
+c      - p_g      ! Constantes physiques ayant des 
+c      - p_mugaz  ! homonymes dynamiques
+c      - p_daysec !
+c
+c=======================================================================
+ 
+      implicit none
+ 
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "planete.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "netcdf.inc"
+#include "dimradmars.h"
+#include "yomaer.h"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c Arguments
+c ---------
+      INTEGER nid,nvarid,tab0
+      INTEGER*4 day_ini
+      INTEGER Lmodif
+      INTEGER lmax
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec,time
+
+c Variables
+c ---------
+      INTEGER length
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! array in which are stored the run's parameters
+      INTEGER  ierr
+      INTEGER size
+      CHARACTER modif*20
+
+c Fonctions DRS et autres
+c -----------------------
+      INTEGER setname, cluvdb, getdat
+
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c  Initialization of various physical constants to defaut values (nid = 0 case)
+c-----------------------------------------------------------------------
+      IF (nid.eq.0) then
+ 
+c Reference pressure
+c-------------------------------------
+c     pressrf = 670.            ! Pression de reference (Pa) ~650
+
+c Infos about Mars for the dynamics and physics
+c----------------------------------------------------------
+      rad=3397200.          ! radius of Mars (m)  ~3397200 m
+      daysec=88775.         ! length of a sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)       ! rotation rate  (rad.s-1)
+      g=3.72                ! gravity (m.s-2) ~3.72
+      mugaz=43.49           ! Molar mass of the atmosphere (g.mol-1) ~43.49
+      rcp=.256793         ! = r/cp  ~0.256793
+
+c Informations about Mars, only for physics
+c-----------------------------------------------------
+      year_day = 669.       !Modif FH: length of year (sols) ~668.6
+      periheli = 206.66         ! min. Sun-Mars distance (Mkm) ~206.66
+      aphelie = 249.22          ! max. Sun-Mars distance (Mkm) ~249.22
+      peri_day =  485.    ! date of perihelion (sols since N. spring)
+      obliquit = 25.19         ! Obliquity of the planet (deg) ~25.19
+
+c Boundary layer and turbulence
+c----------------------------
+      z0 =  1.e-2               ! surface roughness (m) ~0.01
+      emin_turb = 1.e-6         ! minimal energy ~1.e-8
+      lmixmin = 30              ! mixing length ~100
+
+c Optical properties of polar caps and ground emissivity
+c-----------------------------------------------------
+      emissiv=.95               ! Emissivity of martian soil ~.95
+      emisice(1)=0.95           ! Emissivity of northern cap
+      emisice(2)=0.95           ! Emissivity of southern cap
+      albedice(1)=0.65          ! Albedo of northern cap
+      albedice(2)=0.65          ! Albedo of southern cap
+      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) = 0.4   ! time scale for snow metamorphism (north)
+      dtemisice(2) = 0.4   ! time scale for snow metamorphism (south)
+
+c dust aerosol properties
+c---------------------------------
+      tauvis= 0.2          ! mean visible optical depth
+
+c  Ancien code radiatif (non utilise avec le code d'apres 03/96)
+c---------------------------------------------------------------
+c     tauir= 0.  ! .2  ratio (mean IR opt.depth)/Visible
+c     scatalb=0. ! .86 scaterring albedo visible (~.86)
+c     asfact=0.  ! .79 assymetrie factor visible   (~.79)
+c     day0 = 0   ! = 0 en general !!!
+
+c soil properties
+      volcapa = 1.e6 ! soil volumetric heat capacity (in comsoil.h)
+      ELSE
+c-----------------------------------------------------------------------
+c  Initialization of physical constants by reading array tab_cntrl(:)
+c		which contains these parameters	(nid != 0 case)
+c-----------------------------------------------------------------------
+c Read 'controle' array
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Could not find <controle> data"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Tabfi: Failed reading <controle> array"
+         CALL abort
+      ENDIF
+
+       print*,'tabfi: tab_cntrl',tab_cntrl
+c
+c  Initialization of some physical constants
+c informations on physics grid
+      if(ngridmx.ne.tab_cntrl(tab0+1)) then
+         print*,'tabfi: WARNING !!! tab_cntrl(tab0+1).ne.ngridmx'
+         print*,tab_cntrl(tab0+1),ngridmx
+      endif
+      lmax = nint(tab_cntrl(tab0+2))
+      day_ini = tab_cntrl(tab0+3)
+      time = tab_cntrl(tab0+4)
+      write (*,*) 'IN tabfi day_ini=',day_ini
+c Informations about planet Mars for dynamics and physics
+      rad = tab_cntrl(tab0+5)
+      omeg = tab_cntrl(tab0+6)
+      g = tab_cntrl(tab0+7)
+      mugaz = tab_cntrl(tab0+8)
+      rcp = tab_cntrl(tab0+9)
+      daysec = tab_cntrl(tab0+10)
+      dtphys = tab_cntrl(tab0+11)
+c Informations about planet Mars for the physics only
+      year_day = tab_cntrl(tab0+14)
+      periheli = tab_cntrl(tab0+15)
+      aphelie = tab_cntrl(tab0+16)
+      peri_day = tab_cntrl(tab0+17)
+      obliquit = tab_cntrl(tab0+18)
+c boundary layer and turbeulence
+      z0 = tab_cntrl(tab0+19)
+      lmixmin = tab_cntrl(tab0+20)
+      emin_turb = tab_cntrl(tab0+21)
+c optical properties of polar caps and ground emissivity
+      albedice(1)= tab_cntrl(tab0+22)
+      albedice(2)= tab_cntrl(tab0+23)
+      emisice(1) = tab_cntrl(tab0+24)
+      emisice(2) = tab_cntrl(tab0+25)
+      emissiv    = tab_cntrl(tab0+26)
+      tauvis     = tab_cntrl(tab0+27)  ! dust opt. depth vis.
+      iceradius(1)= tab_cntrl(tab0+31) ! mean scat radius of CO2 snow (north)
+      iceradius(2)= tab_cntrl(tab0+32) ! mean scat radius of CO2 snow (south)
+      dtemisice(1)= tab_cntrl(tab0+33) !time scale for snow metamorphism (north)
+      dtemisice(2)= tab_cntrl(tab0+34) !time scale for snow metamorphism (south)
+c soil properties
+      volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity
+c-----------------------------------------------------------------------
+c	Save some constants for later use (as routine arguments)
+c-----------------------------------------------------------------------
+      p_omeg = omeg
+      p_g = g
+      p_mugaz = mugaz
+      p_daysec = daysec
+      p_rad=rad
+
+      ENDIF    ! end of (nid = 0) 
+
+c-----------------------------------------------------------------------
+c	Write physical constants to output before modifying them
+c-----------------------------------------------------------------------
+ 
+   6  FORMAT(a20,e15.6,e15.6)
+   5  FORMAT(a20,f12.2,f12.2)
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)
+      write(*,*) 'Lmodif in tabfi!!!!!!!',Lmodif
+
+c-----------------------------------------------------------------------
+c	 Modifications...
+c-----------------------------------------------------------------------
+
+      IF(Lmodif.eq.1) then
+
+      write(*,*)
+      write(*,*) 'Change values in tab_cntrl ? :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*) '(Current values given above)'
+      write(*,*)
+      write(*,*) '(3)          day_ini : Initial day (=0 at Ls=0)'
+      write(*,*) '(19)              z0 :  surface roughness (m)'
+      write(*,*) '(21)       emin_turb :  minimal energy (PBL)'
+      write(*,*) '(20)         lmixmin : mixing length (PBL)'
+      write(*,*) '(26)         emissiv : ground emissivity'
+      write(*,*) '(24 et 25)   emisice : CO2 ice max emissivity '
+      write(*,*) '(22 et 23)  albedice : CO2 ice cap albedos'
+      write(*,*) '(31 et 32) iceradius : mean scat radius of CO2 snow'
+      write(*,*) '(33 et 34) dtemisice : time scale for snow',
+     &           ' metamorphism'
+      write(*,*) '(27)        tauvis : mean dust vis. reference ',
+     &           'opacity'
+      write(*,*) '(35)         volcapa : soil volumetric heat capacity'
+      write(*,*) '(18)        obliquit : planet obliquity (deg)'
+      write(*,*) '(17)      peri_day : perihelion date (sol since Ls=0)'
+      write(*,*) '(15)      periheli : min. sun-mars dist (Mkm)'
+      write(*,*) '(16)      aphelie  : max. sun-mars dist (Mkm)'
+      write(*,*)
+ 
+ 
+      do while(modif(1:1).ne.'hello')
+        write(*,*)
+        write(*,*)
+        write(*,*) 'Changes to perform ?'
+        write(*,*) '   (enter keyword or return )'
+        write(*,*)
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') goto 999
+ 
+        write(*,*)
+        write(*,*) modif(1:lnblnk(modif)) , ' : '
+
+        if (modif(1:lnblnk(modif)) .eq. 'day_ini') then
+          write(*,*) 'current value:',day_ini
+          write(*,*) 'enter new value:'
+ 101      read(*,*,iostat=ierr) day_ini
+          if(ierr.ne.0) goto 101
+          write(*,*) ' '
+          write(*,*) 'day_ini (new value):',day_ini
+
+        else if (modif(1:lnblnk(modif)) .eq. 'z0') then
+          write(*,*) 'current value:',z0
+          write(*,*) 'enter new value:'
+ 102      read(*,*,iostat=ierr) z0
+          if(ierr.ne.0) goto 102
+          write(*,*) ' '
+          write(*,*) ' z0 (new value):',z0
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emin_turb') then
+          write(*,*) 'current value:',emin_turb
+          write(*,*) 'enter new value:'
+ 103      read(*,*,iostat=ierr) emin_turb
+          if(ierr.ne.0) goto 103
+          write(*,*) ' '
+          write(*,*) ' emin_turb (new value):',emin_turb
+
+        else if (modif(1:lnblnk(modif)) .eq. 'lmixmin') then
+          write(*,*) 'current value:',lmixmin
+          write(*,*) 'enter new value:'
+ 104      read(*,*,iostat=ierr) lmixmin
+          if(ierr.ne.0) goto 104
+          write(*,*) ' '
+          write(*,*) ' lmixmin (new value):',lmixmin
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emissiv') then
+          write(*,*) 'current value:',emissiv
+          write(*,*) 'enter new value:'
+ 105      read(*,*,iostat=ierr) emissiv
+          if(ierr.ne.0) goto 105
+          write(*,*) ' '
+          write(*,*) ' emissiv (new value):',emissiv
+
+        else if (modif(1:lnblnk(modif)) .eq. 'emisice') then
+          write(*,*) 'current value emisice(1) North:',emisice(1)
+          write(*,*) 'enter new value:'
+ 106      read(*,*,iostat=ierr) emisice(1)
+          if(ierr.ne.0) goto 106
+          write(*,*) 
+          write(*,*) ' emisice(1) (new value):',emisice(1)
+          write(*,*)
+
+          write(*,*) 'current value emisice(2) South:',emisice(2)
+          write(*,*) 'enter new value:'
+ 107      read(*,*,iostat=ierr) emisice(2)
+          if(ierr.ne.0) goto 107
+          write(*,*) 
+          write(*,*) ' emisice(2) (new value):',emisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'albedice') then
+          write(*,*) 'current value albedice(1) North:',albedice(1)
+          write(*,*) 'enter new value:'
+ 108      read(*,*,iostat=ierr) albedice(1)
+          if(ierr.ne.0) goto 108
+          write(*,*) 
+          write(*,*) ' albedice(1) (new value):',albedice(1)
+          write(*,*)
+
+          write(*,*) 'current value albedice(2) South:',albedice(2)
+          write(*,*) 'enter new value:'
+ 109      read(*,*,iostat=ierr) albedice(2)
+          if(ierr.ne.0) goto 109
+          write(*,*) 
+          write(*,*) ' albedice(2) (new value):',albedice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'iceradius') then
+          write(*,*) 'current value iceradius(1) North:',iceradius(1)
+          write(*,*) 'enter new value:'
+ 110      read(*,*,iostat=ierr) iceradius(1)
+          if(ierr.ne.0) goto 110
+          write(*,*) 
+          write(*,*) ' iceradius(1) (new value):',iceradius(1)
+          write(*,*)
+
+          write(*,*) 'current value iceradius(2) South:',iceradius(2)
+          write(*,*) 'enter new value:'
+ 111      read(*,*,iostat=ierr) iceradius(2)
+          if(ierr.ne.0) goto 111
+          write(*,*) 
+          write(*,*) ' iceradius(2) (new value):',iceradius(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'dtemisice') then
+          write(*,*) 'current value dtemisice(1) North:',dtemisice(1)
+          write(*,*) 'enter new value:'
+ 112      read(*,*,iostat=ierr) dtemisice(1)
+          if(ierr.ne.0) goto 112
+          write(*,*) 
+          write(*,*) ' dtemisice(1) (new value):',dtemisice(1)
+          write(*,*)
+
+          write(*,*) 'current value dtemisice(2) South:',dtemisice(2)
+          write(*,*) 'enter new value:'
+ 113      read(*,*,iostat=ierr) dtemisice(2)
+          if(ierr.ne.0) goto 113
+          write(*,*) 
+          write(*,*) ' dtemisice(2) (new value):',dtemisice(2)
+
+        else if (modif(1:lnblnk(modif)) .eq. 'tauvis') then
+          write(*,*) 'current value:',tauvis
+          write(*,*) 'enter new value:'
+ 114      read(*,*,iostat=ierr) tauvis
+          if(ierr.ne.0) goto 114
+          write(*,*) 
+          write(*,*) ' tauvis (new value):',tauvis
+
+        else if (modif(1:lnblnk(modif)) .eq. 'obliquit') then
+          write(*,*) 'current value:',obliquit
+          write(*,*) 'obliquit should be 25.19 on current Mars'
+          write(*,*) 'enter new value:'
+ 115      read(*,*,iostat=ierr) obliquit
+          if(ierr.ne.0) goto 115
+          write(*,*) 
+          write(*,*) ' obliquit (new value):',obliquit
+
+        else if (modif(1:lnblnk(modif)) .eq. 'peri_day') then
+          write(*,*) 'current value:',peri_day
+          write(*,*) 'peri_day should be 485 on current Mars'
+          write(*,*) 'enter new value:'
+ 116      read(*,*,iostat=ierr) peri_day
+          if(ierr.ne.0) goto 116
+          write(*,*) 
+          write(*,*) ' peri_day (new value):',peri_day
+
+        else if (modif(1:lnblnk(modif)) .eq. 'periheli') then
+          write(*,*) 'current value:',periheli
+          write(*,*) 'perihelion should be 206.66 on current Mars'
+          write(*,*) 'enter new value:'
+ 117      read(*,*,iostat=ierr) periheli
+          if(ierr.ne.0) goto 117
+          write(*,*) 
+          write(*,*) ' periheli (new value):',periheli
+ 
+        else if (modif(1:lnblnk(modif)) .eq. 'aphelie') then
+          write(*,*) 'current value:',aphelie
+          write(*,*) 'aphelion should be 249.22 on current Mars'
+          write(*,*) 'enter new value:'
+ 118      read(*,*,iostat=ierr) aphelie
+          if(ierr.ne.0) goto 118
+          write(*,*) 
+          write(*,*) ' aphelie (new value):',aphelie
+ 
+        else if (modif(1:lnblnk(modif)) .eq. 'volcapa') then
+          write(*,*) 'current value:',volcapa
+          write(*,*) 'enter new value:'
+ 119      read(*,*,iostat=ierr) volcapa
+          if(ierr.ne.0) goto 119
+          write(*,*) 
+          write(*,*) ' volcapa (new value):',volcapa
+ 
+        endif
+      enddo ! of do while(modif(1:1).ne.'hello')
+
+ 999  continue
+
+c-----------------------------------------------------------------------
+c	Write values of physical constants after modifications
+c-----------------------------------------------------------------------
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+ 
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periheli',tab_cntrl(tab0+15),periheli
+      write(*,5) '(16)        aphelie',tab_cntrl(tab0+16),aphelie
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+ 
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+ 
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+ 
+      write(*,5) '(27)         tauvis',tab_cntrl(tab0+27),tauvis
+
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)  
+      write(*,*) 
+
+      ENDIF 			!	of if (Lmodif == 1)
+
+c-----------------------------------------------------------------------
+c	Case when using a start file from before March 1996 (without iceradius...
+c-----------------------------------------------------------------------
+      if (iceradius(1).eq.0) then 
+         iceradius(1) = 100.e-6
+         iceradius(2) = 100.e-6
+         dtemisice(1) = 0.4
+         dtemisice(2) = 0.4
+         write (*,*) ' tabfi: WARNING : old initialisation file'
+         write (*,*) 'iceradius set to',iceradius(1),iceradius(2)  
+         write (*,*) 'dtemisice set to',dtemisice(1),dtemisice(2)  
+       end if
+
+c-----------------------------------------------------------------------
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tracer.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tracer.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/tracer.h	(revision 46)
@@ -0,0 +1,60 @@
+!-----------------------------------------------------------------------
+! INCLUDE 'tracer.h'
+
+      character*20  noms(nqmx)  ! name of the tracer
+      real mmol(nqmx)           ! mole mass of tracer (g/mol-1) 
+      real radius(nqmx)   ! dust and ice particle radius (m)
+      real rho_q(nqmx)    ! tracer densities (kg.m-3)
+      real qext(nqmx)     ! Single Scat. Extinction coeff at 0.67 um
+      real alpha_lift(nqmx) ! saltation vertical flux/horiz flux ratio (m-1)
+      real alpha_devil(nqmx) ! lifting coeeficient by dust devil
+
+      real varian      ! Characteristic variance of log-normal distribution
+      real r3n_q     ! used to compute r0 from number and mass mixing ratio
+      real qextrhor(nqmx) ! Intermediate for computing opt. depth from q
+      real rho_dust     ! Mars dust density (kg.m-3)
+      real rho_ice     ! Water ice density (kg.m-3)
+      real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+
+      real dryness(ngridmx)!"Dryness coefficient" for grnd water ice sublimation
+      
+! tracer indexes: these are initialized in initracer and should be 0 if the
+!                 corresponding tracer does not exist
+      ! dust
+      integer :: igcm_dustbin(nqmx) ! for dustbin 'dust' tracers
+      ! dust, special doubleq case
+      integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+      integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+      ! water
+      integer :: igcm_h2o_vap ! water vapour
+      integer :: igcm_h2o_ice ! water ice
+      ! chemistry:
+      integer :: igcm_co2
+      integer :: igcm_co
+      integer :: igcm_o
+      integer :: igcm_o1d
+      integer :: igcm_o2
+      integer :: igcm_o3
+      integer :: igcm_h
+      integer :: igcm_h2
+      integer :: igcm_oh
+      integer :: igcm_ho2
+      integer :: igcm_h2o2
+      integer :: igcm_n2
+      integer :: igcm_ar
+      
+      ! other tracers
+      integer :: igcm_ar_n2 ! for simulations using co2 +neutral gas
+
+
+! NB: to keep commons aligned: 
+!     split them in groups (reals, integers and characters)
+      COMMON/tracer/radius,rho_q,qext,alpha_lift,alpha_devil,mmol,      &
+     & varian,r3n_q,qextrhor,rho_dust,rho_ice,ref_r0,dryness
+      COMMON/tracer2/
+     & igcm_dustbin,igcm_dust_mass,igcm_dust_number,                    &
+     & igcm_h2o_vap,igcm_h2o_ice,igcm_co2,igcm_co,igcm_o,igcm_o1d,      &
+     & igcm_o2,igcm_o3,igcm_h,igcm_h2,igcm_oh,igcm_ho2,igcm_h2o2,       &
+     & igcm_n2,igcm_ar,igcm_ar_n2!,nbqchem,niqchem
+      COMMON/tracer3/noms
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/updatereffrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/updatereffrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/updatereffrad.F	(revision 46)
@@ -0,0 +1,121 @@
+      SUBROUTINE updatereffrad(ngrid,nlayer,
+     &                pplev,pplay,
+     &                rice,nuice,
+     &                reffrad,nueffrad)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to update the aerosol size distribution used by
+c     the radiative transfer scheme. This size distribution is assumed
+c     to be a log-normal distribution, with effective radius "reffrad" and
+c     variance "nueffrad".
+c   At firstcall, "rice" and "nuice" are not known, because
+c     the H2O ice microphysical scheme is called after the radiative
+c     transfer in physiq.F. That's why we call watercloud at firstcall
+c     in physiq.F before calling updatereffrad. Of course, resulting
+c     tendencies are not used to compute the water cycle.
+c   See callradite.F for more information.
+c
+c   author:   
+c   ------
+c   J.-B. Madeleine (2009)
+c
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "dimradmars.h"
+#include "tracer.h"
+
+c-----------------------------------------------------------------------
+c     Inputs:
+c     ------
+
+      INTEGER :: ngrid,nlayer
+c     Pressure between each layer (Pa)
+      REAL pplev(ngrid,nlayer+1)
+c     Pressure in the middle of each layer (Pa)
+      REAL pplay(ngrid,nlayer)
+c     Estimated ice crystal radius (m)
+      REAL :: rice(ngridmx,nlayermx)
+c     Estimated effective variance of the size distribution (n.u.)
+      REAL :: nuice(ngridmx,nlayermx)
+
+c     Outputs:
+c     -------
+
+c     Aerosol effective radius used for radiative transfer (meter)
+      REAL :: reffrad(ngridmx,nlayermx,naerkind)
+c     Aerosol effective variance used for radiative transfer (n.u.)
+      REAL :: nueffrad(ngridmx,nlayermx,naerkind)
+
+c     Local variables:
+c     ---------------
+
+      INTEGER :: ig,l                          ! 3D grid indices
+      INTEGER :: iaer                          ! Aerosol index
+
+c     Hyperbolic tangent function coefficients used to describe
+c       dust size vertical profile (reff=f(pplay))
+      REAL, PARAMETER :: dustcoefa = 0.10003736
+      REAL, PARAMETER :: dustcoefb = 0.77463902
+      REAL, PARAMETER :: dustcoefc = 3.1483479
+      REAL, PARAMETER :: dustcoefd = 2.4331281
+
+c     Local saved variables:
+c     ---------------------
+
+c==================================================================
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+        aerkind: SELECT CASE (iaer)
+c==================================================================
+        CASE(1) aerkind                             ! Dust (iaer=1)
+c==================================================================
+
+c         Particule size distribution computed below will be used
+c           only if there are more than one particule size in the
+c           ASCII file which contains the scattering parameters
+c           (see callradite.F for more information).
+c         Dust particle size distribution is deduced from dust 
+c           transport simulations. The resulting mean vertical size
+c           distribution is fitted with a function of the form
+c           f(x)= a+b*[1+tanh( (log(x)-c)/d )], f being the dust
+c           particle radius and x the atmospheric pressure
+c           in a given layer. Then it is used below to define a
+c           "background" dust size distribution.
+c         Effective variance is set to 0.3.
+
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              reffrad(ig,l,iaer)=(log(pplay(ig,l)) - dustcoefc) /
+     &                           dustcoefd
+              reffrad(ig,l,iaer)=max(( (1.E0 + 
+     &                                 tanh(reffrad(ig,l,iaer))) * 
+     &                                 dustcoefb + dustcoefa ) *
+     &                                 1E-6,1.E-9)
+              nueffrad(ig,l,iaer)=0.3
+            ENDDO
+          ENDDO
+
+c==================================================================
+        CASE(2) aerkind               ! Water ice crystals (iaer=2)
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              reffrad(ig,l,iaer)=rice(ig,l)
+              nueffrad(ig,l,iaer)=nuice(ig,l)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind
+      ENDDO ! iaer (loop on aerosol kind)
+
+      RETURN
+      END 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_cd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_cd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_cd.F	(revision 46)
@@ -0,0 +1,116 @@
+      SUBROUTINE vdif_cd( ngrid,nlay,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Subject: computation of the surface drag coefficient using the
+c   -------  approch developed by Loui for ECMWF.
+c
+c   Author: Frederic Hourdin  15 /10 /93
+c   -------
+c
+c   Arguments:
+c   ----------
+c
+c   inputs:
+c   ------
+c     ngrid            size of the horizontal grid
+c     pg               gravity (m s -2)
+c     pz(ngrid)        height of the first atmospheric layer
+c     pu(ngrid)        u component of the wind in that layer
+c     pv(ngrid)        v component of the wind in that layer
+c     pts(ngrid)       surfacte temperature
+c     ph(ngrid)        potential temperature T*(p/ps)^kappa
+c
+c   outputs:
+c   --------
+c     pcdv(ngrid)      Cd for the wind
+c     pcdh(ngrid)      Cd for potential temperature
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pz0
+      REAL pg,pz(ngrid,nlay)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay)
+      REAL pts(ngrid,nlay),ph(ngrid,nlay)
+      REAL pcdv(ngrid),pcdh(ngrid)
+
+c   Local:
+c   ------
+
+      INTEGER ig
+
+      REAL zu2,z1,zri,zcd0,zz
+
+      REAL karman,b,c,d,c2b,c3bc,c3b,umin2
+      LOGICAL firstcal
+      DATA karman,b,c,d,umin2/.4,5.,5.,5.,1.e-12/
+      DATA firstcal/.true./
+      SAVE b,c,d,karman,c2b,c3bc,c3b,firstcal,umin2
+
+c-----------------------------------------------------------------------
+c   couche de surface:
+c   ------------------
+
+c     DO ig=1,ngrid
+c        zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c        pcdv(ig)=pz0*(1.+sqrt(zu2))
+c        pcdh(ig)=pcdv(ig)
+c     ENDDO
+c     RETURN
+c
+c      IF (firstcal) THEN
+c         c2b=2.*b
+c         c3bc=3.*b*c
+c         c3b=3.*b
+c         firstcal=.false.
+c      ENDIF
+c
+c!!!! WARNING, verifier la formule originale de Louis!
+c      DO ig=1,ngrid
+c         zu2=pu(ig)*pu(ig)+pv(ig)*pv(ig)+umin2
+c         zri=pg*pz(ig)*(ph(ig)-pts(ig))/(ph(ig)*zu2)
+c._.
+c            zri=0.E+0
+c._.
+c         z1=1.+pz(ig)/pz0
+c         zcd0=karman/log(z1)
+c._.         zcd0=zcd0*zcd0*sqrt(zu2)
+c         zcd0=zcd0*zcd0
+c         IF(zri.LT.0.) THEN
+c._.            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri))
+c            z1=b*zri/(1.+c3bc*zcd0*sqrt(-z1*zri*zu2))
+c            pcdv(ig)=zcd0*(1.-2.*z1)
+c            pcdh(ig)=zcd0*(1.-3.*z1)
+c         ELSE
+c            zz=sqrt(1.+d*zri)
+c            pcdv(ig)=zcd0/(1.+c2b*zri/zz)
+c            pcdh(ig)=zcd0/(1.+c3b*zri*zz)
+c         ENDIF
+c      ENDDO
+
+
+c On calcule un VRAI cdrag tout bete
+
+      DO ig=1,ngrid
+         z1=1.E+0 + pz(ig,1)/pz0
+         zcd0=karman/log(z1)
+         zcd0=zcd0*zcd0
+         pcdv(ig)=zcd0
+         pcdh(ig)=zcd0
+      ENDDO
+
+       
+
+
+c-----------------------------------------------------------------------
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_kc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_kc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdif_kc.F	(revision 46)
@@ -0,0 +1,554 @@
+      SUBROUTINE vdif_kc(dt,g,zlev,zlay,u,v,teta,cd,q2,km,kn)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphys.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g
+      REAL zlev(ngridmx,nlayermx+1)
+      REAL zlay(ngridmx,nlayermx)
+      REAL u(ngridmx,nlayermx)
+      REAL v(ngridmx,nlayermx)
+      REAL teta(ngridmx,nlayermx)
+      REAL cd(ngridmx)
+      REAL q2(ngridmx,nlayermx+1)
+      REAL km(ngridmx,nlayermx+1)
+      REAL kn(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(ngridmx,nlayermx)
+      REAL unsdzdec(ngridmx,nlayermx+1)
+      REAL q(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(ngridmx,nlayermx+1)
+      REAL qcstat
+      REAL q2cstat
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(ngridmx,nlayermx+1)
+      REAL mpre(ngridmx,nlayermx+1)
+      REAL m2(ngridmx,nlayermx+1)
+      REAL n2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(ngridmx,nlayermx+1)
+      REAL sn(ngridmx,nlayermx+1)
+      REAL snq2(ngridmx,nlayermx+1)
+      REAL sm(ngridmx,nlayermx+1)
+      REAL smq2(ngridmx,nlayermx+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long0 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long0
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long0=160.E+0)
+      PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.E-3)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=nlayermx)
+      PARAMETER (nlev=nlayermx+1)
+      PARAMETER (ngrid=ngridmx)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+c                                                     DO igrid=1,ngrid 
+c           zlev(igrid,nlev)=zlay(igrid,nlay)
+c    &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+c                                                     ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdifc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdifc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vdifc.F	(revision 46)
@@ -0,0 +1,606 @@
+      SUBROUTINE vdifc(ngrid,nlay,nq,co2ice,ppopsk,
+     $                ptimestep,pcapcal,lecrit,
+     $                pplay,pplev,pzlay,pzlev,pz0,
+     $                pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     $                pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,
+     $                pdqdif,pdqsdif)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c   Turbulent diffusion (mixing) for potential T, U, V and tracer
+c
+c   Shema implicite
+c   On commence par rajouter au variables x la tendance physique
+c   et on resoult en fait:
+c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+c
+c   author:
+c   ------
+c      Hourdin/Forget/Fournier
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+
+#include "watercap.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+
+c    Argument added for condensation:
+      REAL co2ice (ngrid), ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+c    Traceurs :
+      integer nq 
+      REAL pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngridmx)
+      REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx),zcdh(ngridmx)
+      REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL ztsrf2(ngridmx)
+      REAL z1(ngridmx),z2(ngridmx)
+      REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx)
+      REAL zb0(ngridmx,nlayermx)
+      REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx)
+      REAL zcst1
+      REAL zu2
+
+      EXTERNAL SSUM,SCOPY
+      REAL SSUM
+      LOGICAL firstcall
+      SAVE firstcall
+
+c     variable added for CO2 condensation:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+      REAL hh , zhcond(ngridmx,nlayermx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond
+      SAVE acond,bcond
+      DATA latcond,tcond1mb/5.9e5,136.27/
+
+c    Tracers :
+c    ~~~~~~~ 
+      INTEGER iq
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq1temp(ngridmx)
+      REAL rho(ngridmx) ! near surface air density
+      REAL qsat(ngridmx)
+      DATA firstcall/.true./
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans vdifc'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+c        To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+         bcond=1./tcond1mb
+         acond=r/latcond
+         PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'          acond,bcond',acond,bcond
+
+        firstcall=.false.
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+      nlev=nlay+1
+
+c    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
+c       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
+c       ----------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(r*r)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s      (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s      (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+		 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
+      ENDDO
+
+c    ** diagnostique pour l'initialisation
+c       ----------------------------------
+
+      IF(lecrit) THEN
+         ig=ngrid/2+1
+         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
+         DO ilay=1,nlay
+            WRITE(*,'(6f11.5)')
+     s      .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
+     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
+         ENDDO
+         PRINT*,'Pression (mbar) ,altitude (km),zb'
+         DO ilev=1,nlay
+            WRITE(*,'(3f15.7)')
+     s      .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
+     s      zb0(ig,ilev)
+         ENDDO
+      ENDIF
+
+c     Potential Condensation temperature:
+c     -----------------------------------
+
+c     if (callcond) then 
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) =
+c    &  (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev)
+c         END DO
+c       END DO
+c     else
+        call zerophys(ngrid*nlay,zhcond)
+c     end if
+
+
+c-----------------------------------------------------------------------
+c   2. ajout des tendances physiques
+c      -----------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
+         ENDDO
+      ENDDO
+      if(tracer) then
+        DO iq =1, nq
+         DO ilev=1,nlay
+           DO ig=1,ngrid
+              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+c-----------------------------------------------------------------------
+c   3. schema de turbulence
+c      --------------------
+
+c    ** source d'energie cinetique turbulente a la surface
+c       (condition aux limites du schema de diffusion turbulente
+c       dans la couche limite
+c       ---------------------
+
+      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph
+     &             ,zcdv_true,zcdh_true)
+      DO ig=1,ngrid
+        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+c    ** schema de diffusion turbulente dans la couche limite
+c       ---------------------------------------------------- 
+
+        CALL vdif_kc(ptimestep,g,pzlev,pzlay
+     &              ,pu,pv,ph,zcdv_true
+     &              ,pq2,zkv,zkh)
+
+
+
+c    ** diagnostique pour le schema de turbulence
+c       -----------------------------------------
+
+      IF(lecrit) THEN
+         PRINT*
+         PRINT*,'Diagnostic for the vertical turbulent mixing'
+         PRINT*,'Cd for momentum and potential temperature'
+
+         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
+         PRINT*,'Mixing coefficient for momentum and pot.temp.'
+         DO ilev=1,nlay
+            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
+         ENDDO
+      ENDIF
+
+
+
+
+c-----------------------------------------------------------------------
+c   4. inversion pour l'implicite sur u
+c      --------------------------------
+
+c    ** l'equation est 
+c       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+c       avec
+c       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Ku
+ 
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   5. inversion pour l'implicite sur v
+c      --------------------------------
+
+c    ** l'equation est 
+c       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+c       avec
+c       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   6. inversion pour l'implicite sur h sans oublier le couplage
+c      avec le sol (conduction)
+c      ------------------------
+
+c    ** l'equation est 
+c       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+c       avec
+c       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+c       donc les entrees sont /zcdh/ pour la condition de raccord au sol
+c       et /zkh/ = Kh
+c       -------------
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+c    ** calcul de (d Planck / dT) a la temperature d'interface
+c       ------------------------------------------------------
+
+      z4st=4.*5.67e-8*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+c    ** calcul de la temperature_d'interface et de sa tendance.
+c       on ecrit que la somme des flux est nulle a l'interface
+c       a t + \delta t,
+c       c'est a dire le flux radiatif a {t + \delta t}
+c       + le flux turbulent a {t + \delta t} 
+c            qui s'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
+c            (notation K dt = /cpp*b/)        
+c       + le flux dans le sol a t
+c       + l'evolution du flux dans le sol lorsque la temperature d'interface
+c       passe de sa valeur a t a sa valeur a {t + \delta t}.
+c       ----------------------------------------------------
+
+      DO ig=1,ngrid
+         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
+     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
+         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
+         ztsrf2(ig)=z1(ig)/z2(ig)
+         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
+
+c        Modif speciale CO2 condensation:
+c        tconds = 1./(bcond-acond*log(.0095*pplev(ig,1)))
+c        if ((callcond).and.
+c    &      ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
+c           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
+c        else
+            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
+c        end if
+      ENDDO
+
+c    ** et a partir de la temperature au sol on remonte 
+c       -----------------------------------------------
+
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond
+            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+         ENDDO
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   TRACERS
+c   -------
+
+      if(tracer) then
+
+c     Using the wind modified by friction for lifting and  sublimation
+c     ----------------------------------------------------------------
+        DO ig=1,ngrid
+          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+        ENDDO
+
+c       Calcul du flux vertical au bas de la premiere couche (dust) :
+c       -----------------------------------------------------------
+        do ig=1,ngridmx  
+          rho(ig) = zb0(ig,1) /ptimestep
+!          zb(ig,1) = 0.
+        end do
+c       Dust lifting:
+        if (lifting) then 
+           call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     $                  pdqsdif)
+       
+        else
+           call zerophys(ngrid*nq,pdqsdif)
+        end if
+
+c       OU calcul de la valeur de q a la surface (water)  :
+c       ----------------------------------------
+        if (water) then 
+            call watersat(ngridmx,ptsrf,pplev(1,1),qsat)
+        end if
+
+c      Inversion pour l'implicite sur q 
+c       --------------------------------
+        do iq=1,nq
+          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+
+          if ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c            This line is required to account for turbulent transport 
+c            from surface (e.g. ice) to mid-layer of atmosphere:
+             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
+             CALL multipl(ngrid,dryness,zb(1,1),zb(1,1)) 
+          else ! (re)-initialize zb(:,1)
+             zb(1:ngrid,1)=0
+          end if
+
+          DO ig=1,ngrid
+               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+          ENDDO
+  
+          DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+               ENDDO
+          ENDDO
+
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            ! special case for water ice tracer: do not include
+            ! h2o ice tracer from surface (which is set when handling
+            ! h2o vapour case (see further down).
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2)) *z1(ig)
+            ENDDO
+          else ! general case
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2) +
+     $        (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
+            ENDDO
+          endif ! of if (water.and.(iq.eq.igcm_h2o_ice))
+  
+          IF ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c           Calculation for turbulent exchange with the surface (for ice)
+            DO ig=1,ngrid
+              zd(ig,1)=zb(ig,1)*z1(ig)
+              zq1temp(ig)=zc(ig,1)+ zd(ig,1)*qsat(ig)
+
+              pdqsdif(ig,igcm_h2o_ice)=rho(ig)*dryness(ig)*zcdv(ig)
+     &                       *(zq1temp(ig)-qsat(ig))
+c             write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+            END DO
+
+            DO ig=1,ngrid
+              if(.not.watercaptag(ig)) then
+                if ((-pdqsdif(ig,igcm_h2o_ice)*ptimestep)
+     &             .gt.pqsurf(ig,igcm_h2o_ice)) then
+c                 write(*,*)'on sublime plus que qsurf!'
+                  pdqsdif(ig,igcm_h2o_ice)=
+     &                         -pqsurf(ig,igcm_h2o_ice)/ptimestep
+c                 write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
+                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_h2o_vap)+
+     $            zb(ig,2)*zc(ig,2) +
+     $            (-pdqsdif(ig,igcm_h2o_ice)) *ptimestep) *z1(ig)
+                  zq1temp(ig)=zc(ig,1)
+                endif   
+              endif ! if (.not.watercaptag(ig))
+c             Starting upward calculations for water :
+               zq(ig,1,igcm_h2o_vap)=zq1temp(ig)
+            ENDDO ! of DO ig=1,ngrid
+          ELSE
+c           Starting upward calculations for simple mixing of tracer (dust)
+            DO ig=1,ngrid
+               zq(ig,1,iq)=zc(ig,1)
+            ENDDO
+          END IF ! of IF ((water).and.(iq.eq.igcm_h2o_vap))
+
+          DO ilay=2,nlay
+             DO ig=1,ngrid
+                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
+             ENDDO
+          ENDDO
+        enddo ! of do iq=1,nq
+      end if ! of if(tracer)
+
+c-----------------------------------------------------------------------
+c   8. calcul final des tendances de la diffusion verticale
+c      ----------------------------------------------------
+
+      DO ilev = 1, nlay
+         DO ig=1,ngrid
+            pdudif(ig,ilev)=(    zu(ig,ilev)-
+     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
+            pdvdif(ig,ilev)=(    zv(ig,ilev)-
+     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
+            hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,
+     $           zhcond(ig,ilev))        ! modif co2cond
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         ENDDO
+      ENDDO
+
+    
+      if (tracer) then 
+        DO iq = 1, nq
+          DO ilev = 1, nlay
+            DO ig=1,ngrid
+              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     $      (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        ENDDO
+      end if
+
+c    ** diagnostique final 
+c       ------------------
+
+      IF(lecrit) THEN
+         PRINT*,'In vdif'
+         PRINT*,'Ts (t) and Ts (t+st)'
+         WRITE(*,'(a10,3a15)')
+     s   'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
+         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
+         DO ilev=1,nlay
+            WRITE(*,'(4f15.7)')
+     s      ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev),
+     s      pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
+
+         ENDDO
+      ENDIF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vlz_fi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vlz_fi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/vlz_fi.F	(revision 46)
@@ -0,0 +1,195 @@
+      SUBROUTINE vlz_fi(ngrid,q,pente_max,masse,w,wq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " dans la verticale
+c    pour appel dans la physique (sedimentation)
+c    ********************************************************************
+c    q rapport de melange (kg/kg)...
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "dimphys.h"
+
+c
+c
+c   Arguments:
+c   ----------
+      integer ngrid
+      real masse(ngrid,llm),pente_max
+      REAL q(ngrid,llm)
+      REAL w(ngrid,llm)
+      REAL wq(ngrid,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+
+      real dzq(ngridmx,llm),dzqw(ngridmx,llm),adzqw(ngridmx,llm),dzqmax
+      real newmasse
+      real sigw, Mtot, MQtot
+      integer m
+
+      REAL      SSUM,CVMGP,CVMGT
+      integer ismax,ismin
+
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+      do l=2,llm
+         do ij=1,ngrid
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         enddo
+      enddo
+
+      do l=2,llm-1
+         do ij=1,ngrid
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            if(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) then
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            else
+                dzq(ij,l)=0.
+            endif
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         enddo
+      enddo
+
+      do ij=1,ngrid
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      enddo
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+c
+c      No flux at the model top:
+       do ij=1,ngrid
+          wq(ij,llm+1)=0.
+       enddo
+
+c      1) Compute wq where w > 0 (down) (ALWAYS FOR SEDIMENTATION)     
+c      ===============================
+
+       do l = 1,llm          ! loop different than when w<0
+        do  ij = 1,ngrid
+
+         if(w(ij,l).gt.0.)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(ij,l).le.masse(ij,l))then
+            sigw=w(ij,l)/masse(ij,l)
+            wq(ij,l)=w(ij,l)*(q(ij,l)+0.5*(1.-sigw)*dzq(ij,l))
+            
+
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+            m=l
+            Mtot = masse(ij,m)
+            MQtot = masse(ij,m)*q(ij,m)
+            if(m.ge.llm)goto 88
+            do while(w(ij,l).gt.(Mtot+masse(ij,m+1)))
+                m=m+1
+                Mtot = Mtot + masse(ij,m)
+                MQtot = MQtot + masse(ij,m)*q(ij,m)
+                if(m.ge.llm)goto 88
+            end do
+ 88         continue
+            if (m.lt.llm) then
+                sigw=(w(ij,l)-Mtot)/masse(ij,m+1)
+                wq(ij,l)=(MQtot + (w(ij,l)-Mtot)*
+     &          (q(ij,m+1)+0.5*(1.-sigw)*dzq(ij,m+1)) )
+            else
+                w(ij,l) = Mtot
+                wq(ij,l) = Mqtot 
+            end if
+          end if
+         end if
+        enddo
+       enddo
+
+c      2) Compute wq where w < 0 (up) (NOT USEFUL FOR SEDIMENTATION)     
+c      ===============================
+       goto 99 ! SKIPPING THIS PART FOR SEDIMENTATION 
+
+c      Surface flux up:
+       do  ij = 1,ngrid
+         if(w(ij,1).lt.0.) wq(ij,1)=0. ! warning : not always valid
+       end do
+
+       do l = 1,llm-1  ! loop different than when w>0
+        do  ij = 1,ngrid
+         if(w(ij,l+1).le.0)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(-w(ij,l+1).le.masse(ij,l))then
+            sigw=w(ij,l+1)/masse(ij,l)
+            wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+             m = l-1
+             Mtot = masse(ij,m+1)
+             MQtot = masse(ij,m+1)*q(ij,m+1)
+             if (m.le.0)goto 77
+             do while(-w(ij,l+1).gt.(Mtot+masse(ij,m)))
+                m=m-1
+                Mtot = Mtot + masse(ij,m+1)
+                MQtot = MQtot + masse(ij,m+1)*q(ij,m+1)
+                if (m.le.0)goto 77
+             end do
+ 77          continue
+
+             if (m.gt.0) then
+                sigw=(w(ij,l+1)+Mtot)/masse(ij,m)
+                wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*
+     &          (q(ij,m)-0.5*(1.+sigw)*dzq(ij,m))  )
+             else
+c               wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*qm(ij,1))
+                write(*,*) 'a rather weird situation in vlz_fi !'
+                stop
+             end if
+          endif
+         endif
+        enddo
+       enddo
+ 99    continue
+
+      do l=1,llm
+         do ij=1,ngrid
+
+cccccccc lines below not used for sedimentation (No real flux)
+ccccc       newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l) 
+ccccc       q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+ccccc&         /newmasse
+ccccc       masse(ij,l)=newmasse
+
+            q(ij,l)=q(ij,l) +  (wq(ij,l+1)-wq(ij,l))/masse(ij,l)
+
+         enddo
+      enddo
+
+
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercap.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercap.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercap.h	(revision 46)
@@ -0,0 +1,6 @@
+c-----------------------------------------------------------------------
+c INCLUDE 'watercap.h'
+
+      logical watercaptag(ngridmx)
+
+      common/permcap/watercaptag
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercloud.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercloud.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watercloud.F	(revision 46)
@@ -0,0 +1,351 @@
+       SUBROUTINE watercloud(ngrid,nlay, ptimestep, 
+     &                pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt,
+     &                pq,pdq,pdqcloud,pdqscloud,pdtcloud,
+     &                nq,naersize,tau,
+     &                rnuclei,rice,nuice)
+      IMPLICIT NONE
+
+c=======================================================================
+c     Treatment of saturation of water vapor
+c
+c
+c     Modif de zq si saturation dans l'atmopshere
+c     si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
+c     Le test est effectue de bas en haut. L'eau condensee
+c    (si saturation) est remise dans la couche en dessous.
+c     L'eau condensee dans la couche du bas est deposee a la surface
+c       
+c    Modification: Franck Montmessin water ice scheme
+c                  Francois Forget : change nuclei density & outputs   
+c                  Ehouarn Millour: sept.2008, tracers are now handled
+c                                   by name (and not fixed index)
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "comgeomfi.h"
+
+c   Inputs:
+c   ------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep             ! pas de temps physique (s)
+      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
+      REAL pplay(ngrid,nlay)     ! pression au milieu des couches (Pa)
+      REAL pdpsrf(ngrid)         ! tendance surf pressure
+      REAL pzlev(ngrid,nlay+1)   ! altitude at layer boundaries
+      REAL pzlay(ngrid,nlay)     ! altitude at the middle of the layers
+      REAL pt(ngrid,nlay)        ! temperature at the middle of the layers (K)
+      REAL pdt(ngrid,nlay)       ! tendance temperature des autres param.
+
+      real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
+      real pdq(ngrid,nlay,nq)    ! tendance avant condensation  (kg/kg.s-1)
+
+      integer nq         ! nombre de traceurs 
+      integer naersize   ! nombre de traceurs radiativement actifs (=naerkind)
+      REAL tau(ngridmx,naersize)
+
+c   Outputs:
+c   -------
+
+      real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1)
+      real pdqscloud(ngrid,nq)     ! flux en surface (kg.m-2.s-1)
+      REAL pdtcloud(ngrid,nlay)    ! tendance temperature due a la chaleur latente
+
+      REAL rnuclei(ngrid,nlay) ! Prescribed dust radius in each
+                               !   layer (m)
+      REAL rice(ngrid,nlay)    ! Estimated ice crystal radius (m)
+      REAL nuice(ngrid,nlay)   ! Estimated effective variance
+                               !   of the size distribution
+
+c   local:
+c   ------
+
+      REAL CBRT
+      EXTERNAL CBRT
+      INTEGER ig,iq,l
+
+
+      REAL zq(ngridmx,nlayermx,nqmx)  ! local value of tracers
+      REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers
+      REAL zqsat(ngridmx,nlayermx)    ! saturation
+      REAL zt(ngridmx,nlayermx)       ! local value of temperature
+
+
+      REAL masse (ngridmx,nlayermx)
+      REAL epaisseur (ngridmx,nlayermx)
+      REAL dustcores(ngridmx,nlayermx)  !Dust number density (#/kg) 
+      REAL rfinal        ! Ice crystal radius after condensation(m)
+      REAL seq           ! Equilibrium saturation ration (accounting for curvature effect)
+      REAL dzq           ! masse de glace echangee (kg/kg)
+      REAL lw       !Latent heat of sublimation (J.kg-1) 
+      REAL,PARAMETER :: To=273.15 ! reference temperature, T=273.15 K
+
+      REAL Ctot
+      REAL*8 ph2o,satu
+      REAL gr,Cste,up,dwn,newvap
+
+      LOGICAL,SAVE :: firstcall=.true.
+! To use more refined microphysics, set improved to .true. 
+      LOGICAL,PARAMETER :: improved=.true.
+
+
+c     Pour diagnostique :
+c     ~~~~~~~~~~~~~~~~~
+c     REAL icetot(ngridmx)             ! Total mass of water ice (kg/m2)
+c     REAL rave(ngridmx)               ! Mean crystal radius in a column (m)
+
+      INTEGER i
+
+! indexes of water vapour, water ice and dust tracers:
+      INTEGER,SAVE :: i_dust=0 ! dust
+      INTEGER,SAVE :: i_h2o=0  ! water vapour
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarly store text
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+        IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans watercloud'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+        ENDIF
+         
+        if (nq.gt.nqmx) then
+           write(*,*) 'stop in watercloud (nq.gt.nqmx)!'
+           write(*,*) 'nq=',nq,' nqmx=',nqmx
+           stop
+        endif
+         
+        do iq=1,nqmx
+          tracername=noms(iq)
+          if (tracername(1:4).eq."dust") then
+            i_dust=iq
+          endif
+!          if (tracername.eq."h2o_ice") then
+!            i_ice=iq
+!          endif
+!          if (tracername.eq."h2o_vap") then
+!            i_h2o=iq
+!          endif
+        enddo
+        i_h2o=igcm_h2o_vap
+        i_ice=igcm_h2o_ice
+        
+        write(*,*) "watercloud: i_dust=",i_dust
+        write(*,*) "            i_ice=",i_ice
+        write(*,*) "            i_h2o=",i_h2o
+        
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c    On "update" la valeur de q(nqmx) (water vapor) et temperature.
+c    On effectue qqes calculs preliminaires sur les couches : 
+c    masse (kg.m-2), epaisseur(m).
+
+      do l=1,nlay
+        do ig=1,ngrid
+          zq(ig,l,i_h2o)=pq(ig,l,i_h2o)+pdq(ig,l,i_h2o)*ptimestep
+          zq(ig,l,i_h2o)=max(zq(ig,l,i_h2o),1.E-30) ! FF 12/2004 
+          zq0(ig,l,i_h2o)=zq(ig,l,i_h2o)
+          zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
+          epaisseur(ig,l)= pzlev(ig,l+1) - pzlev(ig,l)
+
+          zq(ig,l,i_ice)=pq(ig,l,i_ice)+pdq(ig,l,i_ice)*ptimestep
+          zq(ig,l,i_ice)=max(zq(ig,l,i_ice),0.) ! FF 12/2004 
+          zq0(ig,l,i_ice)=zq(ig,l,i_ice)
+          rnuclei(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
+c         Calcul du rayon moyen des particules de glace.
+c         Hypothese : Dans une couche, la glace presente se
+c         repartit uniformement autour du nbre de poussieres
+c         dont le rayon moyen est prescrit par rnuclei.
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if ((dustbin.eq.1).and.(.not.(doubleq))) then
+            zq(ig,l,i_dust)=pq(ig,l,i_dust)+pdq(ig,l,i_dust)*ptimestep
+              dustcores(ig,l)=max(zq(ig,l,i_dust)/
+     &         (rho_dust*4./3.*pi*radius(i_dust)**3.),1.e-9)
+          else
+            dustcores(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
+     &     2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
+
+c            TEMPORAIRE : réduction du nombre de nuclei FF 04/2008 :
+c              dustcores(ig,l) = dustcores(ig,l) / 27. ! reduction facteur 3
+            dustcores(ig,l) = dustcores(ig,l) / 8. ! reduction facteur 2
+          endif
+          rice(ig,l)=CBRT( ( zq(ig,l,i_ice)/rho_ice+
+     &       dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3. )
+     &       / (dustcores(ig,l)*4./3.*pi) )
+          rice(ig,l)=max(rice(ig,l),rnuclei(ig,l))
+c         Effective variance of the size distribution
+          nuice(ig,l)=0.1
+        enddo ! of do ig=1,ngrid
+      enddo ! of dol=1,nlay
+
+      call zerophys(ngrid*nq,pdqscloud)
+      call zerophys(ngrid*nlay*nq,pdqcloud)
+      call zerophys(ngrid*nlay,pdtcloud)
+
+c     call zerophys(ngrid,icetot)
+c     call zerophys(ngrid,rave)
+
+c    ----------------------------------------------
+c
+c
+c       Rapport de melange a saturation dans la couche l : -------
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        call watersat(ngridmx*nlayermx,zt,pplay,zqsat)
+
+c       taux de condensation (kg/kg/s-1) dans les differentes couches
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       Iceparty is not used anymore: water=>iceparty (JBM).
+c       if(iceparty) then
+
+        do l=1,nlay
+          do ig=1,ngrid
+
+          IF (improved) then
+c         Improved microphysics scheme
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           Ctot = zq(ig,l,i_h2o) + zq(ig,l,i_ice)
+           ph2o = zq(ig,l,i_h2o) * 44. / 18. * pplay(ig,l)
+           satu = zq(ig,l,i_h2o) / zqsat(ig,l)
+
+           call growthrate(ptimestep,zt(ig,l),pplay(ig,l),
+     &        ph2o,ph2o/satu,seq,rice(ig,l),gr)
+           Cste = ptimestep * 4. * pi * rice(ig,l)
+     *              * rho_ice * dustcores(ig,l)
+           up   = zq(ig,l,i_h2o) + Cste * gr * seq
+           dwn  =    1.       + Cste * gr / zqsat(ig,l)
+           newvap = min(up/dwn,Ctot)
+
+           gr  = gr * ( newvap/zqsat(ig,l) - seq )
+           dzq = min( max( Cste * gr,-zq(ig,l,i_ice) ) 
+     *             , zq(ig,l,i_h2o) )
+
+c          Nucleation (sat ratio must be larger than a critical value)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           if (satu.gt.1.) then
+             if (satu.le.1.4.and.zq(ig,l,i_ice).lt.1.e-8) 
+     *          dzq = 0.
+           endif
+
+           ELSE
+c          Old version
+c          ~~~~~~~~~~~
+           if (zq(ig,l,i_h2o).ge.zqsat(ig,l))then  !  Condensation
+             dzq=zq(ig,l,i_h2o)-zqsat(ig,l)                
+           elseif(zq(ig,l,i_h2o).lt.zqsat(ig,l))then  ! Sublimation
+             dzq=-min(zqsat(ig,l)-zq(ig,l,i_h2o),zq(ig,l,i_ice))
+           endif
+
+           ENDIF ! of IF (improved)
+
+c           Water Mass change
+c           ~~~~~~~~~~~~~~~~~
+            zq(ig,l,i_ice)=zq(ig,l,i_ice)+dzq
+            zq(ig,l,i_h2o)=zq(ig,l,i_h2o)-dzq
+
+            rice(ig,l)=max( CBRT ( (zq(ig,l,i_ice)/rho_ice
+     &       +dustcores(ig,l)*(4./3.)*pi*rnuclei(ig,l)**3.)
+     &       /(dustcores(ig,l)*4./3.*pi) ), rnuclei(ig,l)) 
+
+            enddo ! of do ig=1,ngrid
+          enddo ! of do l=1,nlay
+
+c       The following part have been commented because iceparty
+c           is not used anymore: water=>iceparty (JBM).
+
+c       else   ! if not iceparty
+
+c         Saturation couche nlay a 2 :
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         do l=nlay,2, -1
+c          do ig=1,ngrid
+c           if (zq(ig,l,i_h2o).gt.zqsat(ig,l))then 
+c             zq(ig,l-1,i_h2o)= zq(ig,l-1,i_h2o)+
+c    &                          (zq(ig,l,i_h2o)-zqsat(ig,l))
+c    &          *(pplev(ig,l)-pplev(ig,l+1))/(pplev(ig,l-1)-pplev(ig,l))
+c             zq(ig,l,i_h2o)=zqsat(ig,l)
+c           endif
+c          enddo
+c         enddo
+
+c       Saturation couche l=1 si pas iceparty 
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         do ig=1,ngridmx
+c           if (zq(ig,1,i_h2o).gt.zqsat(ig,1))then
+c             pdqscloud(ig,i_ice)=(zq(ig,1,i_h2o)-zqsat(ig,1))
+c    &           *(pplev(ig,1)-pplev(ig,2))/(g*ptimestep)
+c             zq(ig,1,i_h2o)=zqsat(ig,1)
+c           endif
+c         enddo
+
+c       endif   ! of if (iceparty)
+
+c       Tendance finale
+c       ~~~~~~~~~~~~~~~
+        do l=1, nlay
+          do ig=1,ngridmx
+            pdqcloud(ig,l,i_h2o)=(zq(ig,l,i_h2o)
+     &                              -zq0(ig,l,i_h2o))/ptimestep
+            pdqcloud(ig,l,i_ice) =
+     &        (zq(ig,l,i_ice) - zq0(ig,l,i_ice))/ptimestep
+            lw=(2834.3-0.28*(zt(ig,l)-To)-0.004*(zt(ig,l)-To)**2)*1.e+3
+            pdtcloud(ig,l)=-pdqcloud(ig,l,i_h2o)*lw/cpp
+          end do 
+        end do
+
+c       A correction if a lot of subliming CO2 fills the 1st layer FF04/2005
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c       Then that should not affect the ice particle radius
+        do ig=1,ngridmx
+          if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,2)))then
+            if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,3)))
+     &      rice(ig,2)=rice(ig,3) 
+            rice(ig,1)=rice(ig,2)
+          end if
+        end do
+        
+c**************************************************
+c       Output  
+c**************************************************
+! NB: for diagnostics use zq(), the updated value of tracers
+
+c        do ig=1,ngridmx
+c         do l=1 ,nlay
+c           masse de glace d'eau dans la couche l
+c           icetot(ig)=icetot(ig)+masse(ig,l)*zq(ig,l,i_ice)
+c           rayon moyen des cristaux dans la colonne ig
+c           rave(ig)=rave(ig)+masse(ig,l)*zq(ig,l,i_ice)*rice(ig,l)
+c         enddo
+c         rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+c         if (icetot(ig)*1000.lt.0.01) rave(ig)=0.
+c        enddo   ! (ngridmx)
+c**************************************************
+
+ 99   continue
+
+      RETURN
+      END
+ 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watersat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watersat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/watersat.F	(revision 46)
@@ -0,0 +1,47 @@
+      SUBROUTINE watersat(naersize,t,p,qsat)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Water mass mixing ratio at saturation (kg/kg) for a given pressure (Pa)
+c   and Temperature (K) array
+c
+c=======================================================================
+
+c   declarations:
+c   -------------
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer naersize 
+      real t(naersize) , p(naersize)
+c   OUTPUT
+      real qsat(naersize)
+
+c   local:
+c   ------
+      INTEGER i
+      REAL r2,r3,r4 , To, es
+      SAVE r2,r3,r4
+      DATA r2,r3,r4/611.14,21.875,7.66/
+      SAVE To
+      DATA To/273.16/
+          
+      do i=1,naersize
+c        pression de vapeur saturante :
+c         es =r2*exp(r3*(t(i)-To)/(t(i)-r4))
+c         qsat(i)=es/p(i)*0.41  !rapport de melange
+        es=2.07023-0.00320991*t(i)-2484.896/t(i)+3.56654*alog10(t(i))
+        es=10.**es 
+        qsat(i)=(es*100.)/p(i)*0.41 
+
+c        qss = specific humidity
+c        qss=622*10**(2.07023-0.0032991*Tsurf(ig)-2484.896/Tsurf(ig)
+c    $                  +3.56654*log10(Tsurf(ig)))
+
+      enddo
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagfi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagfi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagfi.F	(revision 46)
@@ -0,0 +1,360 @@
+      subroutine writediagfi(ngrid,nom,titre,unite,dim,px)
+
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  Dans la version 2000, la periode d'ecriture est celle de 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 2, ou 3d)
+!      dim : dimension de px : 0, 2, ou 3 dimensions
+!
+!=================================================================
+ 
+      implicit none
+
+! Commons
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "netcdf.inc"
+#include "temps.h"
+#include "surfdat.h"
+
+! Arguments on input:
+      integer ngrid
+      character (len=*) :: nom,titre,unite
+      integer dim
+      real px(ngrid,llm)
+
+! Local variables:
+
+      real dx3(iip1,jjp1,llm) ! to store a 3D data set
+      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+      real dx0
+
+      real date
+
+      REAL phis(ip1jmp1)
+
+      integer irythme
+      integer ierr
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer zitau
+      character firstnom*20
+      SAVE firstnom
+      SAVE zitau
+      SAVE date
+      data firstnom /'1234567890'/
+      data zitau /0/
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character (len =50):: fichnom
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+      
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = int(ecritphy) ! sortie au rythme de ecritphy
+!     irythme = iconser  ! sortie au rythme des variables de controle
+!     irythme = iphysiq  ! sortie a tous les pas physique
+!     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
+!     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
+
+!***************************************************************
+
+! The following test is here to enforce that writediagfi is not used with the
+! 1D version of the GCM
+      if (ngrid.eq.1) return
+      
+c     nom=trim((nom))
+c     unite=trim((unite))
+c     titre=trim((titre))
+
+! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+! ------------------------------------------------------------------------
+! (Au tout premier appel de la subroutine durant le run.)
+
+      fichnom="diagfi.nc"
+
+      if (firstnom.eq.'1234567890') then ! .true. for the very first call
+      !  to this subroutine; now set 'firstnom'
+         firstnom = nom
+         ! just to be sure, check that firstnom is large enough to hold nom
+         if (len_trim(firstnom).lt.len_trim(nom)) then
+           write(*,*) "writediagfi: Error !!!"
+           write(*,*) "   firstnom string not long enough!!"
+           write(*,*) "   increase its size to at least ",len_trim(nom)
+           stop
+         endif
+
+         ! Create the NetCDF file
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+         ! Define the 'Time' dimension
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+         ! Define the 'Time' variable
+#ifdef NC_DOUBLE
+         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+#endif
+         ! Add a long_name attribute
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ! Add a units attribute
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ! Switch out of NetCDF Define mode
+         ierr = NF_ENDDEF(nid)
+
+         ! write "header" of file (longitudes, latitudes, geopotential, ...)
+         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
+         call iniwrite(nid,day_ini,phis)
+         
+         zitau = -1 ! initialize zitau
+      else
+         ! Open the NetCDF file
+         ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+      endif ! if (firstnom.eq.'1234567890')
+
+! Increment time index 'zitau' if it is the "fist call" (at given time level)
+! to writediagfi
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          zitau = zitau + iphysiq
+      end if
+
+!--------------------------------------------------------
+! Write the variables to output file if it's time to do so
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+! Compute/write/extend 'Time' coordinate (date given in days)
+! (done every "first call" (at given time level) to writediagfi)
+! Note: date is incremented as 1 step ahead of physics time
+!       (like the 'histoire' outputs)
+!--------------------------------------------------------
+
+        if (nom.eq.firstnom) then
+        ! We have identified a "first call" (at given date)
+           ntime=ntime+1 ! increment # of stored time steps
+           ! compute corresponding date (in days and fractions thereof)
+           date= float (zitau +1)/float (day_step)
+           ! Get NetCDF ID of 'Time' variable
+           ierr= NF_INQ_VARID(nid,"Time",varid)
+           ! Write (append) the new date to the 'Time' array
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+           endif
+
+           write(6,*)'WRITEDIAGFI: date= ', date
+        end if ! of if (nom.eq.firstnom)
+
+!Case of a 3D variable
+!---------------------
+        if (dim.eq.3) then
+
+!         Passage variable physique -->  variable dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+           DO l=1,llm
+             DO i=1,iip1
+                dx3(i,1,l)=px(1,l)
+                dx3(i,jjp1,l)=px(ngrid,l)
+             ENDDO
+             DO j=2,jjm
+                ig0= 1+(j-2)*iim
+                DO i=1,iim
+                   dx3(i,j,l)=px(ig0+i,l)
+                ENDDO
+                dx3(iip1,j,l)=dx3(1,j,l)
+             ENDDO
+           ENDDO
+
+!         Ecriture du champs
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+! name of the variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif 
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Case of a 2D variable
+!---------------------
+
+        else if (dim.eq.2) then
+
+!         Passage variable physique -->  physique dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+
+             DO i=1,iip1
+                dx2(i,1)=px(1,1)
+                dx2(i,jjp1)=px(ngrid,1)
+             ENDDO
+             DO j=2,jjm
+                ig0= 1+(j-2)*iim
+                DO i=1,iim
+                   dx2(i,j)=px(ig0+i,1)
+                ENDDO
+                dx2(iip1,j)=dx2(1,j)
+             ENDDO
+
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+!Case of a 0D variable (ie: a time-dependent scalar)
+!---------------------------------------------------
+
+        else if (dim.eq.0) then
+           dx0 = px (1,1)
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+c             call abort
+           endif 
+
+        endif ! of if (dim.eq.3) elseif(dim.eq.2)...
+
+      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
+
+      ierr= NF_CLOSE(nid)
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagsoil.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagsoil.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writediagsoil.F90	(revision 46)
@@ -0,0 +1,270 @@
+subroutine writediagsoil(ngrid,name,title,units,dimpx,px)
+
+! Write variable 'name' to NetCDF file 'diagsoil.nc'.
+! The variable may be 3D (lon,lat,depth) subterranean field,
+! a 2D (lon,lat) surface field, or a simple scalar (0D variable).
+!
+! Calls to 'writediagsoil' can originate from anywhere in the program;
+! An initialisation of variable 'name' is done if it is the first time
+! that this routine is called with given 'name'; otherwise data is appended
+! (yielding the sought time series of the variable)
+
+implicit none
+
+#include"dimensions.h"
+#include"dimphys.h"
+#include"paramet.h"
+#include"control.h"
+#include"comsoil.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid
+! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm
+character(len=*),intent(in) :: name ! 'name' of the variable
+character(len=*),intent(in) :: title ! 'long_name' attribute of the variable
+character(len=*),intent(in) :: units ! 'units' attribute of the variable
+integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0)
+real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable
+! Note: nsoilmx is a common parameter set in 'dimphys.h'
+
+! Local variables:
+real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h
+real,dimension(iip1,jjp1) :: data2 ! to store 2D data
+real :: data0 ! to store 0D data
+integer :: i,j,l ! for loops
+integer :: ig0
+
+real,save :: date ! time counter (in elapsed days)
+integer,save :: isample ! sample rate at which data is to be written to output
+integer,save :: ntime=0 ! counter to internally store time steps
+character(len=20),save :: firstname="1234567890"
+integer,save :: zitau=0
+
+character(len=30) :: filename="diagsoil.nc"
+
+! NetCDF stuff:
+integer :: nid ! NetCDF output file ID
+integer :: varid ! NetCDF ID of a variable
+integer :: ierr ! NetCDF routines return code
+integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable
+integer,dimension(4) :: edges,corners
+
+! 1. Initialization step
+if (firstname.eq."1234567890") then
+  ! Store 'name' as 'firstname'
+  firstname=name
+  ! From now on, if 'name'.eq.'firstname', then it is a new time cycle
+
+  ! just to be sure, check that firstnom is large enough to hold nom
+  if (len_trim(firstname).lt.len_trim(name)) then
+    write(*,*) "writediagsoil: Error !!!"
+    write(*,*) "   firstname string not long enough!!"
+    write(*,*) "   increase its size to at least ",len_trim(name)
+    stop
+  endif
+  
+  ! Set output sample rate
+  isample=int(ecritphy) ! same as for diagfi outputs
+  ! Note ecritphy is known from control.h
+  
+  ! Create output NetCDF file
+  ierr=NF_CREATE(filename,NF_CLOBBER,nid)
+  if (ierr.ne.NF_NOERR) then
+    write(*,*)'writediagsoil: Error, failed creating file '//trim(filename)
+    stop
+  endif
+  
+  ! Define dimensions and axis attributes
+  call iniwritesoil(nid)
+  
+  ! set zitau to -1 to be compatible with zitau incrementation step below
+  zitau=-1
+  
+else
+  ! If not an initialization call, simply open the NetCDF file
+  ierr=NF_OPEN(filename,NF_WRITE,nid)
+endif ! of if (firstname.eq."1234567890")
+
+! 2. Increment local time counter, if necessary
+if (name.eq.firstname) then
+  ! if we run across 'firstname', then it is a new time step
+  zitau=zitau+iphysiq
+  ! Note iphysiq is known from control.h
+endif
+
+! 3. Write data, if the time index matches the sample rate
+if (mod(zitau+1,isample).eq.0) then
+
+! 3.1 If first call at this date, update 'time' variable
+  if (name.eq.firstname) then
+    ntime=ntime+1
+    date=float(zitau+1)/float(day_step)
+    ! Note: day_step is known from control.h
+    
+    ! Get NetCDF ID for "time"
+    ierr=NF_INQ_VARID(nid,"time",varid)
+    ! Add the current value of date to the "time" array
+#ifdef NC_DOUBLE
+    ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+    ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+    if (ierr.ne.NF_NOERR) then
+      write(*,*)"writediagsoil: Failed writing date to time variable"
+      stop 
+    endif
+  endif ! of if (name.eq.firstname)
+
+! 3.2 Write the variable to the NetCDF file
+if (dimpx.eq.3) then ! Case of a 3D variable
+  ! A. Recast data along 'dynamics' grid
+  do l=1,nsoilmx
+    ! handle the poles
+    do i=1,iip1
+      data3(i,1,l)=px(1,l)
+      data3(i,jjp1,l)=px(ngrid,l)
+    enddo
+    ! rest of the grid
+    do j=2,jjm
+      ig0=1+(j-2)*iim
+      do i=1,iim
+        data3(i,j,l)=px(ig0+i,l)
+      enddo
+      data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+    enddo
+  enddo
+  
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"depth",id(3))
+    ierr=NF_INQ_DIMID(nid,"time",id(4))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,4,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+  
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=1
+  corners(4)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=nsoilmx
+  edges(4)=1
+  
+  ! B.3. Write the slab of data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+elseif (dimpx.eq.2) then ! Case of a 2D variable
+  ! A. Recast data along 'dynamics' grid
+  ! handle the poles
+  do i=1,iip1
+    data2(i,1)=px(1,1)
+    data2(i,jjp1)=px(ngrid,1)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data2(i,j)=px(ig0+i,1)
+    enddo
+    data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
+  enddo
+
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"time",id(3))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,3,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=1
+  
+  ! B.3. Write the slab of data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+elseif (dimpx.eq.0) then ! Case of a 0D variable
+  ! A. Copy data value
+  data0=px(1,1)
+
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"time",id(1))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,1,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=ntime
+  
+  edges(1)=1
+
+  ! B.3. Write the data
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
+#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
+#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ...
+endif ! of if (mod(zitau+1,isample).eq.0)
+
+! 4. Close the NetCDF file
+ierr=NF_CLOSE(nid)
+
+end subroutine writediagsoil
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writeg1d.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writeg1d.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/writeg1d.F	(revision 46)
@@ -0,0 +1,204 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+      REAL*4 xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+c
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        g1d_premier=.false.
+      ENDIF
+c
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+c
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+c
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+      ivar =min( max(int(1440.*dtphys/daysec +0.5),1) , 99)   
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/wstats.F90
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/wstats.F90	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/wstats.F90	(revision 46)
@@ -0,0 +1,279 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*) :: nom,titre,unite
+integer,intent(in) :: dim
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real, dimension(ngrid,llm) :: px
+real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+character (len=50) :: namebis
+character (len=50), save :: firstvar
+integer :: ierr,varid,nbdim,nid
+integer :: meanid,sdid
+integer, dimension(4)  :: id,start,size
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: index
+
+integer, save :: step=0
+
+
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+   RETURN
+endif
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+
+   if (firstvar==nom) then 
+      index=1
+      count=0
+   endif
+
+
+!declaration de la variable
+
+! choix du nom des coordonnees
+   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+   if (dim.eq.3) then
+      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+      ierr= NF_INQ_DIMID(nid,"Time",id(4))
+      nbdim=4
+   else if (dim==2) then
+      ierr= NF_INQ_DIMID(nid,"Time",id(3))
+      nbdim=3
+   endif
+
+   write (*,*) "====================="
+   write (*,*) "STATS: creation de ",nom
+   namebis=trim(nom)
+   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   namebis=trim(nom)//"_sd"
+   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(index)=count(int(index))+1
+   index=index+1
+   if (index>istime) then
+      index=1
+   endif
+endif
+
+if (count(index)==0) then
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+      mean3d=0
+      sd3d=0
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+      mean2d=0
+      sd2d=0
+   endif
+else
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif
+
+if (dim.eq.3) then
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+   mean3d= mean3d+dx3
+   sd3d= sd3d+dx3**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+
+else if (dim.eq.2) then
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+   mean2d= mean2d+dx2
+   sd2d= sd2d+dx2**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+
+endif
+
+ierr= NF_CLOSE(nid)
+
+end
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,index,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,size
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,index/)
+   size=(/iip1,jjp1,llm,1/)
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#endif
+
+endif
+
+end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yeye
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yeye	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yeye	(revision 46)
@@ -0,0 +1,406 @@
+430,433c430,435
+< !          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+< !     &      ' ',2,taucloudtes)
+< !          CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+< !     &      ' ',2,taucloudtes)
+---
+>           CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+>      &      ' ',2,taucloudtes)
+>           IF (callstats) THEN
+>             CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+>      &        ' ',2,taucloudtes)
+>           ENDIF
+1,2c1
+<       SUBROUTINE dustlift(ngrid,nlay,nq,rho,
+<      $                  pcdh_true,pcdh,co2ice,
+---
+>       SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice,
+45,66c44
+< 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
+< 
+---
+>       DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+46c46,47
+< #include "chimiedata.h"  
+---
+> #include "chimiedata.h"
+> 
+221d221
+<             mmol(iq)=100.
+367,370c367,370
+<         if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+<           write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+<           write(*,*)'water= ',water,' doubleq= ',doubleq   
+<         end if
+---
+> !        if( (nqmx.lt.2).or.(water.and.(nqmx.lt.3)) ) then
+> !          write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+> !          write(*,*)'water= ',water,' doubleq= ',doubleq   
+> !        end if
+404,411c404
+<       else
+< 
+<        if (dustbin.gt.1) then
+<         print*,'ATTENTION:',
+<      $   ' properties of dust need input in initracer !!!'
+<         stop
+< 
+<        else if (dustbin.eq.1) then
+---
+>       endif ! of if (doubleq)
+412a406,408
+>       if (dustbin.gt.0) then
+>         if (dustbin.eq.1) then
+> c
+415,419c411,415
+<         radius(igcm_dustbin(1))=3.e-6
+<         Qext(igcm_dustbin(1))=3.04
+<         alpha_lift(igcm_dustbin(1))=0.0e-6
+<         alpha_devil(igcm_dustbin(1))=7.65e-9
+<         qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+---
+>           radius(igcm_dustbin(1))=3.e-6
+>           Qext(igcm_dustbin(1))=3.04
+>           alpha_lift(igcm_dustbin(1))=0.0e-6
+>           alpha_devil(igcm_dustbin(1))=7.65e-9
+>           qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+421,424c417,423
+<         rho_q(igcm_dustbin(1))=rho_dust
+< 
+<        endif
+<       end if    ! (doubleq)
+---
+>           rho_q(igcm_dustbin(1))=rho_dust
+>         else
+>           write(*,*) "initracer: properties of dust need to be set",
+>      &              " in initracer !!!"
+>           stop
+>         endif ! of if (dustbin.eq.1)
+>       endif ! of if (dustbin.gt.0)
+438,439c437,438
+<             qextrhor(iq)= 0.
+<          endif
+---
+> 	    qextrhor(iq)= 0.
+>           endif
+450c449
+<          qextrhor(igcm_h2o_vap)= 0.
+---
+> 	 qextrhor(igcm_h2o_vap)= 0.
+513a513,649
+> !
+> !     some extra sanity checks for tracers: 
+> !     ------------------------------------
+> 
+>        if (doubleq) then 
+>        ! verify that we indeed have dust_mass and dust_number tracers 
+>          if (igcm_dust_mass.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use doubleq option without ",
+>      &                "a dust_mass tracer !"
+>            stop
+>          endif
+>          if (igcm_dust_number.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use doubleq option without ",
+>      &                "a dust_number tracer !"
+>            stop
+>          endif
+>        endif
+> 
+>        if (dustbin.gt.0) then
+>        ! verify that we indeed have 'dustbin' dust tracers
+>          count=0
+>          do iq=1,dustbin
+>            if (igcm_dustbin(iq).ne.0) then
+>              count=count+1
+>            endif
+>          enddo
+>          if (count.ne.dustbin) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  dusbin is set to ",dustbin,
+>      &                " but we only have the following dust tracers:"
+>            do iq=1,count
+>              write(*,*)"   ",trim(noms(igcm_dustbin(iq)))
+>            enddo
+>            stop
+>          endif
+>        endif
+> 
+>        if (water) then
+>        ! verify that we indeed have h2o_vap and h2o_ice tracers
+>          if (igcm_h2o_vap.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use water option without ",
+>      &                "an h2o_vap tracer !"
+>            stop
+>          endif
+>          if (igcm_h2o_ice.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use water option without ",
+>      &                "an h2o_ice tracer !"
+>            stop
+>          endif
+>        endif
+> 
+>        if (photochem .or. callthermos) then
+>        ! verify that we indeed have the chemistry tracers
+>          if (igcm_co2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a co2 tracer !"
+>          stop
+>          endif
+>          if (igcm_co.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a co tracer !"
+>          stop
+>          endif
+>          if (igcm_o.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a o tracer !"
+>          stop
+>          endif
+>          if (igcm_o1d.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a o1d tracer !"
+>          stop
+>          endif
+>          if (igcm_o2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "an o2 tracer !"
+>          stop
+>          endif
+>          if (igcm_o3.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "an o3 tracer !"
+>          stop
+>          endif
+>          if (igcm_h.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a h tracer !"
+>          stop
+>          endif
+>          if (igcm_h2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a h2 tracer !"
+>          stop
+>          endif
+>          if (igcm_oh.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "an oh tracer !"
+>          stop
+>          endif
+>          if (igcm_ho2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a ho2 tracer !"
+>          stop
+>          endif
+>          if (igcm_h2o2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a h2o2 tracer !"
+>          stop
+>          endif
+>          if (igcm_n2.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "a n2 tracer !"
+>          stop
+>          endif
+>          if (igcm_ar.eq.0) then
+>            write(*,*) "initracer: error !!"
+>            write(*,*) "  cannot use chemistry option without ",
+>      &                "an ar tracer !"
+>          stop
+>          endif
+>        endif ! of if (photochem .or. callthermos)
+> 
+58,61c58,61
+<       tab_cntrl(1)  = FLOAT(iim)
+<       tab_cntrl(2)  = FLOAT(jjm)
+<       tab_cntrl(3)  = FLOAT(llm)
+<       tab_cntrl(4)  = FLOAT(idayref)
+---
+>       tab_cntrl(1)  = real(iim)
+>       tab_cntrl(2)  = real(jjm)
+>       tab_cntrl(3)  = real(llm)
+>       tab_cntrl(4)  = real(idayref)
+426c426
+< 
+---
+>       
+591a592,595
+>   
+> c           Tendencies on T, U, V, Q 
+> c           """"""""""""""""""""""""
+>             DO l=1,nlayer
+593,619c597,615
+< CCCC
+< CCCC *** WRF comments
+< CCCC
+< c 
+< cc           Tendencies on T, U, V, Q 
+< cc           """"""""""""""""""""""""
+< c            DO l=1,nlayer
+< c 
+< cc             Tendencies on T
+< c                zdtsig(ig,l) = (1/masse(l)) *
+< c     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+< c     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+< c     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+< c                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+< c
+< cc             Tendencies on U
+< c                pduc(ig,l)   = (1/masse(l)) *
+< c     &        ( zmflux(l)*(zum(l) - zu(l))
+< c     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+< c
+< c
+< cc             Tendencies on V
+< c                pdvc(ig,l)   = (1/masse(l)) *
+< c     &        ( zmflux(l)*(zvm(l) - zv(l))
+< c     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+< c
+< c            END DO
+---
+> 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
+229,231c229,231
+<       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+<       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+<       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+---
+>       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+>       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+>       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+478,480c478,480
+<       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),float(ngridmx)
+<       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+<       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+---
+>       write(*,5) '(1)      = ngridmx?',tab_cntrl(tab0+1),real(ngridmx)
+>       write(*,5) '(2)            lmax',tab_cntrl(tab0+2),real(lmax)
+>       write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),real(day_ini)
+8c8,9
+< !  Dans la version 2000, la periode d'ecriture est celle de 
+---
+> !  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
+> !  La periode d'ecriture est donnee par 
+33,34c34,35
+< !      px : variable a sortir (real 0, 2, ou 3d)
+< !      dim : dimension de px : 0, 2, ou 3 dimensions
+---
+> !      px : variable a sortir (real 0, 1, 2, ou 3d)
+> !      dim : dimension de px : 0, 1, 2, ou 3 dimensions
+61a63
+>       real dx1(llm)           ! to store a 1D (column) data set
+101,107d102
+< ! The following test is here to enforce that writediagfi is not used with the
+< ! 1D version of the GCM
+<       if (ngrid.eq.1) return
+<       
+< c     nom=trim((nom))
+< c     unite=trim((unite))
+< c     titre=trim((titre))
+154a150,157
+>       if (ngridmx.eq.1) then
+>         ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
+>         ! are undefined; so set them to 1
+>         iphysiq=1 
+>         irythme=1
+>         ! NB: 
+>       endif
+> 
+171d173
+< !       (like the 'histoire' outputs)
+318a321,363
+> !Case of a 1D variable (ie: a column)
+> !---------------------------------------------------
+> 
+>        else if (dim.eq.1) then
+> !         Passage variable physique -->  physique dynamique
+> !         recast (copy) variable from physics grid to dynamics grid
+>           do l=1,llm
+>             dx1(l)=px(1,l)
+>           enddo
+>           
+>           ierr= NF_INQ_VARID(nid,nom,varid)
+>            if (ierr /= NF_NOERR) then
+> ! corresponding dimensions
+>               ierr= NF_INQ_DIMID(nid,"altitude",id(1))
+>               ierr= NF_INQ_DIMID(nid,"Time",id(2))
+> 
+> ! Create the variable if it doesn't exist yet
+> 
+>               write (*,*) "=========================="
+>               write (*,*) "DIAGFI: creating variable ",nom
+> 
+>               call def_var(nid,nom,titre,unite,2,id,varid,ierr)
+>               
+>            endif
+>            
+>            corner(1)=1
+>            corner(2)=ntime
+>            
+>            edges(1)=llm
+>            edges(2)=1
+> #ifdef NC_DOUBLE
+>            ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1)
+> #else
+>            ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1)
+> #endif
+> 
+>            if (ierr.ne.NF_NOERR) then
+>               write(*,*) "***** PUT_VAR problem in writediagfi"
+>               write(*,*) "***** with ",nom
+>               write(*,*) 'ierr=', ierr
+> c             call abort
+>            endif 
+> 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yoegwd.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yoegwd.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yoegwd.h	(revision 46)
@@ -0,0 +1,16 @@
+C     -----------------------------------------------------------------
+C*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+C     -----------------------------------------------------------------
+C
+      real GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+
+      integer NKTOPG
+
+      COMMON/YOEGWD/ GFRCRIT,GRCRIT,GVCRIT,GKDRAG,GKDRAGL,GHMAX
+     *             , GRAHILO,GSIGCR,NKTOPG,GSSEC, GTSEC,  GVSEC
+     *             ,GKWAKE
+C
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomaer.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomaer.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomaer.h	(revision 46)
@@ -0,0 +1,55 @@
+!     Radiative characteristics of the aerosols
+! 
+!   Shortwave
+!   ~~~~~~~~~
+! 
+! tauvis: dust optical depth at reference wavelength  ("longrefvis" set
+! in dimradmars.h : typically longrefvis = 0.67E-6 m, as measured by Viking )
+
+! For the "naerkind" kind of aerosol radiative properties : 
+! QVISsQREF  :  Qext / Qext("longrefvis")   <--- For both solar bands
+! omegavis   :  sinle scattering albedo     <--- For both solar bands
+! gvis       :  assymetry factor            <--- For both solar bands
+! 
+!   Longwave
+!   ~~~~~~~~
+! 
+! For the "naerkind" kind of aerosol radiative properties : 
+! QIRsQREF :  Qext / Qext("longrefvis")     <--- For the nir bandes IR
+! omegaIR  :  mean single scattering albedo <--- For the nir bandes IR
+! gIR      :  mean assymetry factor         <--- For the nir bandes IR
+! 
+      real tauvis
+      real QVISsQREF(nsun,naerkind,nsizemax)
+      real omegavis(nsun,naerkind,nsizemax)
+      real gvis(nsun,naerkind,nsizemax)
+      real QIRsQREF(nir,naerkind,nsizemax)
+      real omegaIR(nir,naerkind,nsizemax)
+      real gIR(nir,naerkind,nsizemax)
+
+! Actual number of grain size classes in each domain for a
+!   given aerosol:
+
+      INTEGER          :: nsize(naerkind,2)
+
+! Particle size axis (depend on the kind of aerosol and the
+!   radiation domain)
+
+      REAL :: radiustab(naerkind,2,nsizemax)
+
+! Extinction coefficient at reference wavelengths;
+!   These wavelengths are defined in dimradmars.h, and called
+!   longrefvis and longrefir.
+
+      REAL             :: QREFvis(naerkind,nsizemax)
+      REAL             :: QREFir(naerkind,nsizemax)
+      REAL             :: omegaREFvis(naerkind,nsizemax)
+      REAL             :: omegaREFir(naerkind,nsizemax)
+
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+
+      COMMON/YOMAER/tauvis,QVISsQREF,omegavis,gvis,                     &
+     &              QIRsQREF,omegaIR,gIR,                               &
+     &              QREFvis,QREFir,omegaREFvis,omegaREFir,              &
+     &              nsize,radiustab
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomlw.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomlw.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/yomlw.h	(revision 46)
@@ -0,0 +1,21 @@
+C*    Coefficients for the longwave radiation subroutines
+c-----------------------------------------------------------------------
+
+      COMMON/yomlw/at(2,2),bt(2,2)
+     S ,tref,xp(6,nir),tstand
+     S ,ga(npademx,nabsmx),gb(npademx,nabsmx)
+     S ,cst_voigt(2,nabsmx), gcp , nlaylte
+
+      REAL at,bt, tref,xp,tstand,ga,gb, cst_voigt
+      REAL gcp    ! = g/cpp
+
+c     Number of layers on which LTE calculations (in lw and sw) are performed 
+c     (Computed in nlthermeq) :
+      INTEGER nlaylte       
+
+
+      COMMON/ksicom/
+     S xi(ngridmx,nuco2,0:nflev+1,0:nflev+1)
+     S ,xi_ground(ngridmx,nuco2),xi_emis(ngridmx,nuco2,nflev-1)
+
+      real xi, xi_ground, xi_emis
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/zerophys.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/zerophys.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/phymars/zerophys.F	(revision 46)
@@ -0,0 +1,11 @@
+      SUBROUTINE zerophys(n,x)
+      IMPLICIT NONE
+      INTEGER n
+      REAL x(n)
+      INTEGER i
+
+      DO i=1,n
+         x(i)=0.
+      ENDDO
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/abort_gcm.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/abort_gcm.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/abort_gcm.F	(revision 46)
@@ -0,0 +1,24 @@
+      SUBROUTINE abort_gcm(modname, message, ierr)
+     
+C
+C Stops the simulation cleanly, closing files and printing various
+C comments
+C
+C  Input: modname = name of calling program
+C         message = stuff to print
+C         ierr    = severity of situation ( = 0 normal )
+
+      character*20 modname
+      integer ierr
+      character*80 message
+
+      write(*,*) 'in abort_gcm'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addfi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addfi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addfi.F	(revision 46)
@@ -0,0 +1,182 @@
+      SUBROUTINE addfi(nq, pdt, leapf, forward,
+     S          pucov, pvcov, pteta, pq   , pps , pmasse ,
+     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c    Addition of the physical tendencies
+c    Modif special Mars :
+c       - no special treatment of iq = 1, 2, FF 2003
+c       - recompute mass after incrementation of ps (EM,FF 2008)
+c
+c    Interface :
+c    -----------
+c
+c      Input :
+c      -------
+c      pdt                    time step of integration
+c      leapf                  logical
+c      forward                logical
+c      pucov(ip1jmp1,llm)     first component of the covariant velocity
+c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
+c      pteta(ip1jmp1,llm)     potential temperature
+c      pts(ip1jmp1,llm)       surface temperature
+c      pdufi(ip1jmp1,llm)     |
+c      pdvfi(ip1jm,llm)       |   respective
+c      pdhfi(ip1jmp1)         |      tendencies
+c      pdtsfi(ip1jmp1)        |
+c
+c      Output :
+c      --------
+c      pucov
+c      pvcov
+c      ph
+c      pts
+c      pmasse(ip1jmp1,llm)    ! mass
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+#include "comvert.h"
+c
+c    Arguments :
+c    -----------
+c
+      INTEGER nq
+
+      REAL pdt
+c
+      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
+      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)
+c
+      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
+      REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
+
+      real pmasse(ip1jmp1,llm)
+c
+      LOGICAL leapf,forward
+c
+c
+c    Local variables :
+c    -----------------
+c
+      REAL xpn(iim),xps(iim),tpn,tps
+      INTEGER j,k,iq,ij
+      REAL qtestw, qtestt
+      PARAMETER ( qtestw = 1.0e-15 )
+      PARAMETER ( qtestt = 1.0e-30 )
+
+      real p(ip1jmp1,llmp1) ! pressure
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c-----------------------------------------------------------------------
+! increment potential temperature
+      DO k = 1,llm
+         DO j = 1,ip1jmp1
+            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+      DO  k    = 1, llm
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
+         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/ apoln
+       tps      = SSUM(iim,xps,1)/ apols
+
+       DO ij   = 1, iip1
+         pteta(   ij   ,k)  = tpn
+         pteta(ij+ip1jm,k)  = tps
+       ENDDO
+      ENDDO
+c
+
+! increment covariant zonal wind
+      DO k = 1,llm
+         DO j = iip2,ip1jm
+            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+! increment covariant meridional wind
+      DO k = 1,llm
+         DO j = 1,ip1jm
+            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
+         ENDDO
+      ENDDO
+
+c
+! increment surface pressure
+      DO j = 1,ip1jmp1
+         pps(j) = pps(j) + pdpfi(j) * pdt
+      ENDDO
+
+c     DO iq = 1, 2 ! special Mars: no special treatment for water
+c        DO k = 1,llm
+c           DO j = 1,ip1jmp1
+c              pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+c              pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
+c           ENDDO
+c        ENDDO
+c     ENDDO
+
+      DO iq = 1, nq
+         DO k = 1,llm
+            DO j = 1,ip1jmp1
+               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
+            ENDDO
+         ENDDO
+      ENDDO
+                                       
+
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pps(  ij     )
+         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/apoln
+       tps      = SSUM(iim,xps,1)/apols
+
+       DO ij   = 1, iip1
+         pps (   ij     )  = tpn
+         pps ( ij+ip1jm )  = tps
+       ENDDO
+
+! recompute mass: (to be synchronous with update of ps)
+      CALL pression ( ip1jmp1, ap, bp, pps, p )
+      CALL massdair (     p  , pmasse         )
+ 
+
+
+       DO iq = 1, nq
+         DO  k    = 1, llm
+           DO  ij   = 1, iim
+             xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
+             xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
+           ENDDO
+           tpn      = SSUM(iim,xpn,1)/apoln
+           tps      = SSUM(iim,xps,1)/apols
+
+           DO ij   = 1, iip1
+             pq (   ij   ,k,iq)  = tpn
+             pq (ij+ip1jm,k,iq)  = tps
+           ENDDO
+         ENDDO
+       ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addit.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addit.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/addit.F	(revision 46)
@@ -0,0 +1,14 @@
+      SUBROUTINE addit(np,px,py,pz)
+      IMPLICIT NONE
+
+      INTEGER np
+      REAL px(np),py(np),pz(np)
+
+      INTEGER i
+
+      DO i=1,np
+	 pz(i)=px(i)+py(i)
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/adv_h2o.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/adv_h2o.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/adv_h2o.F	(revision 46)
@@ -0,0 +1,131 @@
+      SUBROUTINE adv_h2o (nq,iq,q,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont (horiz), moy arithmetique (vert)
+c   (Shema classique pour l'humidite specifique LMD)
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL wsur2(ip1jmp1),ww
+      REAL dqh( ip1jmp1,llm)
+
+      EXTERNAL     convflu
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '  pour l'humidite specifique  q       -
+c     ----------------------------------------------------------------
+c
+      IF( iq.GT.2 )   THEN
+        DO   l = 1, llm
+         DO ij = 1, ip1jmp1
+          dq(ij,l,iq) = 0.
+         ENDDO
+        ENDDO
+            RETURN
+      ENDIF
+
+ 
+      IF( forward.OR.leapf )   THEN
+ 
+        DO 10 l = 1, llm
+ 
+        DO 6  ij     = iip2, ip1jm - 1
+ 
+          IF( pbaru(ij,l).GT.0.  )   THEN
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(  ij  ,l,iq)
+          ELSE
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(ij +1 ,l,iq)
+          ENDIF
+
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+         IF( pbarv(ij,l).GT.0.  )   THEN
+           qbyv( ij,l ) =  pbarv( ij,l )  * q(ij+iip1, l,iq)
+         ELSE
+           qbyv( ij,l ) =  pbarv( ij,l )  * q(   ij  , l,iq)
+         ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+c
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+c
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q ....
+c              (moyenne arithmetique)
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+      DO 20 l = 1,llmm1
+
+c       preliminaires:
+c
+        DO 11 ij = 1,ip1jmp1
+         wsur2( ij ) = - 0.5 * w( ij,l+1 )
+  11    CONTINUE
+
+
+        DO 12 ij = 1,ip1jmp1
+          ww             = wsur2(ij)   * ( q(ij,l,iq) + q(ij,l+1,iq) )
+          dq (ij, l ,iq) = dqh(ij, l ) -  ww
+          dqh(ij,l+1   ) = dqh(ij,l+1) +  ww
+  12    CONTINUE
+c
+  20  CONTINUE 
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm ) 
+        END DO
+           
+      END IF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/advect.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/advect.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/advect.F	(revision 46)
@@ -0,0 +1,164 @@
+      SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , Fr. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   *************************************************************
+c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
+c   *************************************************************
+c        ces termes sont ajoutes a du,dv,dteta et dq .
+c  Modif F.Forget 03/94 : on retire q de advect
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "ener.h"
+
+c   Arguments:
+c   ----------
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
+      REAL unsaire2(ip1jmp1), ge(ip1jmp1)
+      REAL deuxjour, ww, gt, uu, vv
+
+      INTEGER  ij,l
+
+      EXTERNAL  SSUM
+      REAL      SSUM
+
+c-----------------------------------------------------------------------
+c   2. Calculs preliminaires:
+c   -------------------------
+
+      IF (conser)  THEN
+         deuxjour = 2. * daysec
+
+         DO   1  ij   = 1, ip1jmp1
+         unsaire2(ij) = unsaire(ij) * unsaire(ij)
+   1     CONTINUE
+      END IF
+
+
+c------------------  -yy ----------------------------------------------
+c   .  Calcul de     u
+
+      DO  l=1,llm
+         DO    ij     = iip2, ip1jmp1
+            uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
+         ENDDO
+         DO    ij     = iip2, ip1jm
+            uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
+         ENDDO
+         DO      ij         = 1, iip1
+            uav(ij      ,l) = 0.
+            uav(ip1jm+ij,l) = 0.
+         ENDDO
+      ENDDO
+
+c------------------  -xx ----------------------------------------------
+c   .  Calcul de     v
+
+      DO  l=1,llm
+         DO    ij   = 2, ip1jm
+          vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
+         ENDDO
+         DO    ij   = 1,ip1jm,iip1
+          vav(ij,l) = vav(ij+iim,l)
+         ENDDO
+         DO    ij   = 1, ip1jm-1
+          vav(ij,l) = vav(ij,l) + vav(ij+1,l)
+         ENDDO
+         DO    ij       = 1, ip1jm, iip1
+          vav(ij+iim,l) = vav(ij,l)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+c
+      DO 20 l = 1, llmm1
+
+
+c       ......   calcul de  - w/2.    au niveau  l+1   .......
+
+      DO 5   ij   = 1, ip1jmp1
+      wsur2( ij ) = - 0.5 * w( ij,l+1 )
+   5  CONTINUE
+
+
+c     .....................     calcul pour  du     ..................
+
+      DO 6 ij = iip2 ,ip1jm-1
+      ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
+      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
+      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
+      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
+   6  CONTINUE
+
+c     .....  correction pour  du(iip1,j,l)  ........
+c     .....     du(iip1,j,l)= du(1,j,l)   .....
+
+CDIR$ IVDEP
+      DO   7  ij   = iip1 +iip1, ip1jm, iip1
+      du( ij, l  ) = du( ij -iim, l  )
+      du( ij,l+1 ) = du( ij -iim,l+1 )
+   7  CONTINUE
+
+c     .................    calcul pour   dv      .....................
+
+      DO 8 ij = 1, ip1jm
+      ww        = wsur2( ij+iip1 )   + wsur2( ij )
+      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
+      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
+      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
+   8  CONTINUE
+
+c
+
+c     ............................................................
+c     ...............    calcul pour   dh      ...................
+c     ............................................................
+
+c                       ---z
+c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
+c                   ...............
+
+        DO 15 ij = 1, ip1jmp1
+         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
+         dteta(ij, l ) = dteta(ij, l )  -  ww
+         dteta(ij,l+1) = dteta(ij,l+1)  +  ww
+  15    CONTINUE
+
+      IF( conser)  THEN
+        DO 17 ij = 1,ip1jmp1
+        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
+  17    CONTINUE
+        gt       = SSUM( ip1jmp1,ge,1 )
+        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
+      END IF
+
+  20  CONTINUE
+ 
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont.F	(revision 46)
@@ -0,0 +1,125 @@
+      SUBROUTINE amont (nq,iq,q,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont 3D
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq  
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL ww
+      REAL dqh( ip1jmp1,llm)
+
+      EXTERNAL     convflu
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '                                      -
+c     ----------------------------------------------------------------
+c
+      IF( iq.GT.2 )   THEN
+       DO   l = 1, llm
+        DO ij = 1, ip1jmp1
+          dq(ij,l,iq) = 0.
+        ENDDO
+       ENDDO
+            RETURN
+      ENDIF
+ 
+c
+      IF( forward.OR.leapf )   THEN
+ 
+        DO 10 l = 1, llm
+ 
+        DO 6  ij     = iip2, ip1jm - 1
+           IF( pbaru(ij,l).GT.0.  )   THEN
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(  ij  ,l,iq)
+           ELSE
+            qbxu( ij,l ) =  pbaru( ij,l )  * q(ij +1 ,l,iq)
+           ENDIF
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+           IF( pbarv(ij,l).GT.0.  )   THEN
+            qbyv( ij,l ) =  pbarv( ij,l )  * q(ij+iip1, l,iq)
+           ELSE
+            qbyv( ij,l ) =  pbarv( ij,l )  * q(   ij  , l,iq)
+           ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q. Shema amont
+c ---------------------------------------------------------------
+
+c     calcul de  - d( q   * w )    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 20 l = 1,llmm1
+c
+         DO 11 ij = 1,ip1jmp1
+           IF( w(ij,l+1).LT.0.  )   THEN
+            ww  =   - w( ij,l+1 ) * q( ij,  l  ,iq)
+           ELSE
+            ww  =   - w( ij,l+1 ) * q( ij, l +1,iq)
+           ENDIF
+
+          dq (ij, l ,iq ) = dqh(ij, l )   -  ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   +  ww
+  11     CONTINUE
+c
+  20   CONTINUE 
+
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+           
+      END IF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont_qsat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont_qsat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/amont_qsat.F	(revision 46)
@@ -0,0 +1,151 @@
+      SUBROUTINE amont_qsat (nq,iq,q,teta,pk,w, pbaru, pbarv,dq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / F.Forget
+c   -------
+c
+c   ********************************************************************
+c   Transport d'un traceur q par shema amont 3D  avec contrainte thermi-
+c           -que
+c   ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq,iq  
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq), dq( ip1jmp1,llm,nq )
+      REAL teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER   l,ij
+
+      REAL qbyv( ip1jm,llm ), qbxu( ip1jmp1,llm )
+      REAL ww
+      REAL dqh( ip1jmp1,llm)
+
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL rtt,retv,r3les,r3ies,r4les,r4ies,unskappa,play
+      REAL tempe(ip1jmp1),qsat(ip1jmp1,llm),r2es
+
+      EXTERNAL     convflu
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+C
+
+
+c     ----------------------------------------------------------------
+c     --        calcul transport horiz. pour  dq                    --
+c     -                                                              -
+c     -         shema ' amont '                                      -
+c     ----------------------------------------------------------------
+ 
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+ 
+        unskappa =  1./ kappa
+
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   =  preff * (pk(ij,l)/cpp) ** unskappa
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+        DO 10 l = 1, llm
+
+        DO 6  ij     = iip2, ip1jm - 1
+         IF( pbaru(ij,l).GT.0  )  THEN
+          qbxu( ij,l ) = pbaru( ij,l ) * MIN( q(ij,l,iq),qsat(ij +1,l))
+         ELSE
+          qbxu( ij,l ) = pbaru( ij,l ) * MIN( q(ij+1,l,iq),qsat(ij,l) )
+         ENDIF
+       
+   6    CONTINUE
+ 
+c     ..... correction  pour  qbxu(iip1,j,l)   .....
+c     ...   qbxu(iip1,j,l)= qbxu(1,j,l)  ...
+ 
+CDIR$ IVDEP
+        DO  7   ij   = iip1 +iip1, ip1jm, iip1
+        qbxu( ij,l ) = qbxu( ij - iim, l )
+   7    CONTINUE
+ 
+        DO  8  ij     = 1, ip1jm
+         IF( pbarv(ij,l).GT.0  )  THEN
+          qbyv(ij,l) = pbarv( ij,l ) * MIN( q(ij+iip1,l,iq),qsat(ij,l) )
+         ELSE
+          qbyv(ij,l) = pbarv( ij,l ) * MIN( q(ij,l,iq),qsat(ij+iip1,l) )
+         ENDIF
+   8    CONTINUE
+c
+  10    CONTINUE
+ 
+c     stockage dans  dqh de la convergence horiz.du flux d'humidite  .
+c     ------------------------------------------------------------- 
+c
+                  CALL convflu(qbxu, qbyv, llm, dqh )
+
+
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection vertic.pour q. Shema amont
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dqh pour calculer dq
+c
+
+       DO 20 l = 1,llmm1
+c
+         DO 11 ij = 1,ip1jmp1
+           IF( w(ij,l+1).LT.0. )   THEN
+             ww =  -w(ij,l+1) * MIN( q(ij, l ,iq),qsat(ij ,l+1) )
+           ELSE
+             ww =  -w(ij,l+1) * MIN( q(ij,l+1,iq),qsat(ij , l ) )
+           ENDIF
+
+cc     .... Modif . P. Le Van  (26/09/95) ....
+
+          dq (ij, l ,iq ) = dqh(ij, l )   -  ww
+          dqh(ij,l+1    ) = dqh(ij,l+1)   +  ww
+  11     CONTINUE
+c
+  20   CONTINUE 
+
+c
+c       special dq (ij,llm) (qui n'a pas ete rempli ! ) 
+c
+        DO  ij = 1,ip1jmp1
+          dq( ij,llm,iq ) = dqh( ij,llm )
+        END DO
+           
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_mcdstats.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_mcdstats.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_mcdstats.F	(revision 46)
@@ -0,0 +1,1375 @@
+      PROGRAM anldiag_nc
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Program designed to read output files from the MARS gcm
+c or the Mars Climate database.
+c
+c    Francois Forget 1999
+c    Version used by monica to interpolate in zaeroid and p coordinate
+
+c
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"
+
+      INTEGER itau,nbpas,nbpasmx, coor,sor,varoutsize
+      integer varspecsize
+      integer varout(6),varspec(nqmx)
+      integer itau0
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx),y
+      INTEGER unitlec
+      INTEGER i,j,l,irec,itautot,ierr,iq,n,ff,k
+      real, dimension(:),allocatable :: lat,lon,alt
+      integer:: nout,latdimout,londimout,altdimout,timedimout,timevarout
+      integer:: latdim,londim,altdim,dimid
+      integer:: latvar,lonvar,altvar,timevar
+      integer:: latlen,lonlen,altlen,timelen
+      integer, dimension(4) :: edges,corner,id
+      integer, dimension(3) :: edges2,corner2
+
+      INTEGER   unit,nvarid,nid,varid
+      REAL mugaz
+
+      REAL missing
+      PARAMETER(missing=1E+20)
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm),w(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),rho(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+      REAL Rnew(iip1,jjp1,llm)
+      real euv(iip1,jjp1,llm),con(iip1,jjp1,llm),nir(iip1,jjp1,llm)
+      real nspec(iip1,jjp1,llm,nqmx),spec(iip1,jjp1,llm)
+
+      REAL v_sd(iip1,jjp1,llm),u_sd(iip1,jjp1,llm)
+      real w_sd(iip1,jjp1,llm),t_sd(iip1,jjp1,llm)
+      real rho_sd(iip1,jjp1,llm)
+      real euv_sd(iip1,jjp1,llm),con_sd(iip1,jjp1,llm)
+      real nir_sd(iip1,jjp1,llm)
+      real nspec_sd(iip1,jjp1,llm,nqmx)
+
+c   ALtitude of the GCM levels
+c   -------------------------
+      REAL zlocal(iip1,jjp1,llm) ! altitude above the local surface (m)
+      REAL zareoid(iip1,jjp1,llm) ! altitude above the mola areoid (m)
+      real tmean   ! use to integrate hydrostatic equation
+      real Rmean   ! use to integrate hydrostatic equation
+
+c    Also used to integrate hydrostatic equation:
+      real g0 ! exact mean gravity at radius=3396.km (LEMOINE ET AL 2001) 
+      data    g0 /3.7257964/
+      data    a0 /3396.0/  ! radius=3396.km
+      real gz  ! used to estimate gravity in altitude...
+
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm),wp(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm),rhop(iip1,jjp1,llm)
+      REAL nspecp(iip1,jjp1,llm,nqmx)
+      REAL phip(iip1,jjp1,llm)
+      
+      REAL vp_sd(iip1,jjp1,llm),up_sd(iip1,jjp1,llm)
+      real wp_sd(iip1,jjp1,llm),tp_sd(iip1,jjp1,llm)
+      real rhop_sd(iip1,jjp1,llm),nspecp_sd(iip1,jjp1,llm,nqmx)
+ 
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c    Version 32 layers : ************
+c     data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+c     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04/
+
+c    Version 50 layers : ************
+      data pref/
+     &1400., 1100., 800., 565., 400., 280., 200., 140., 100.,
+     &70., 50., 35., 25., 18., 13., 9., 6.,
+     &3.63227,1.803712,0.8956969,0.4447900,0.2208762,0.1096839,
+     &5.4467395E-02,2.7047679E-02,1.3431421E-02,
+     &6.6698161E-03,3.3121328E-03,
+     &1.6447564E-03,8.1676187E-04,4.0559194E-04,2.0141099E-04,
+     &1.0001774E-04,4.9667346E-05,2.4664072E-05,1.2247816E-05,
+     &6.0820857E-06,3.0202741E-06,1.4998238E-06,7.4479044E-07,
+     &3.6985199E-07,1.8366305E-07,9.1204370E-08,4.5290751E-08,
+     &2.2490720E-08,1.1168562E-08,5.5461431E-09,2.7541311E-09,
+     &1.3676602E-09,6.7915956E-10/
+
+c   variables meteo en coordonnee de zareoid
+c   --------------------------------------------
+      REAL va(iip1,jjp1,llm),ua(iip1,jjp1,llm),wa(iip1,jjp1,llm)
+      REAL ta(iip1,jjp1,llm),rhoa(iip1,jjp1,llm),ra(iip1,jjp1,llm)
+      real euva(iip1,jjp1,llm),cona(iip1,jjp1,llm),nira(iip1,jjp1,llm)
+      real nspeca(iip1,jjp1,llm,nqmx)
+
+      REAL va_sd(iip1,jjp1,llm),ua_sd(iip1,jjp1,llm)
+      real wa_sd(iip1,jjp1,llm),ta_sd(iip1,jjp1,llm)
+      real rhoa_sd(iip1,jjp1,llm)
+      real euva_sd(iip1,jjp1,llm),cona_sd(iip1,jjp1,llm)
+      real nira_sd(iip1,jjp1,llm)
+      real nspeca_sd(iip1,jjp1,llm,nqmx)
+
+      REAL vij(llm),uij(llm),zaij(llm),wij(llm),rij(llm)
+      REAL tij(llm),rhoij(llm+1),sigij(llm)
+      real euvij(llm),conij(llm),nirij(llm)
+      real nspecij(llm+1,nqmx)
+
+      REAL vij_sd(llm),uij_sd(llm)
+      real wij_sd(llm),tij_sd(llm),rhoij_sd(llm+1)
+      real euvij_sd(llm),conij_sd(llm),nirij_sd(llm)
+      real nspecij_sd(llm+1,nqmx)
+
+c     Niveaux de zareoid (m)
+      real zaref(llm)
+      real p_zaref,p_zaij(llm+1) ! used to interpolate rho
+
+       data zaref/    
+      & -6.E+3,-4.E+3,-2.E+3,0.E+3,2.E+3,4.E+3,6.E+3,8.E+3,10.E+3,12.E+3
+      & ,14.E+3,16.E+3,18.E+3,22.E+3,26.E+3,30.E+3,34.E+3
+      & ,38.E+3,44.E+3,50.E+3,56.E+3,62.E+3,68.E+3,74.E+3
+      & ,80.E+3,86.E+3,92.E+3,98.E+3,104.E+3,110.E+3,116.E+3
+      & ,122.E+3,128.E+3,134.E+3,140.E+3,146.E+3,152.E+3,158.E+3
+      & ,164.E+3,170.E+3,176.E+3,182.E+3,188.E+3,194.E+3,200.E+3
+      & ,206.E+3,212.E+3,218.E+3,224.E+3,230.E+3/
+
+
+c   Surface data (sometime needed for some analysis):
+c   ------------------------------------------------
+      character relief*3
+      real phis(iip1,jjp1)
+      real alb(iip1,jjp1),ith(iip1,jjp1)
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+
+      real utime
+      real localtime(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+      integer nmoy(jjp1,llm),tp1,tp2,pass
+
+      CHARACTER*1 yes,yescomp
+
+      integer iformat
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+      CHARACTER nomfile(2)*60,nomfileout(2)*60
+      integer fichsize,fstats
+      CHARACTER fdiag*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+      character*10  noms(nqmx),varnoms(6)
+c      data          noms/"co2","co","o","o1d","o2","o3","h","h2",
+c     $                   "oh","ho2","h2o2", "n2", "h2o"/
+c      data          varnoms/"T","U","V","W","RHO","Species"/
+
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unitlec=11
+      itautot=0
+
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      print*,' ' 
+      PRINT*,'File to process: 1)DIAGFI 2)STATS 3)BOTH'
+      READ(5,'(i)') fichsize
+      if(fichsize.ne.2)then
+        i=1
+        PRINT*,'   enter name of diagfi file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        fdiag=nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+      endif
+      if(fichsize.ne.1)then
+        i=i+1
+        PRINT*,'   enter name of stats file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+        if(fichsize.eq.2) then
+          PRINT*,'   enter name of diagfi file for controle (w/o .nc)'
+          read(5,'(a)') fdiag
+        endif
+        fstats=1
+      endif
+      if (fichsize.ge.2) fichsize=fichsize-1
+      print*,' '
+      print*,'Output in: 1) netcdf 2) IDL 3) both ?'
+      READ(5,'(i)') sor
+      print*,' '
+      print*,'Coordinates in: 1) pressure 2) Zareoid 3) both  ?'
+      READ(5,'(i)') coor
+
+c ************* Partie a moderniser !!! FF 2004 ************
+      print*,' '
+      print*,'Fields:  T  U  V  W  Rho  Species  All   ?'
+      print*,'Type total number of desired outputs or 6 for All   '
+      READ(5,'(i)') varoutsize
+      if(varoutsize.lt.6) then
+        print*,' '
+        print*,'Fields:  T  U  V  W  Rho  Species '
+        print*,'  #   :  1  2  3  4   5      6'
+        print*,' '
+        do i=1,varoutsize
+          print*,'Type number of variable ',i
+          READ(5,'(i)') varout(i)
+        enddo
+      endif
+      if(varoutsize.eq.6) then
+        do i=1,6
+          varout(i)=i
+        enddo
+      endif
+      do i=1,varoutsize
+        if (varout(i).eq.6) then
+           print*,'Type total number of desired species or 13 for All'
+           READ(5,'(i2)') varspecsize
+           if(varspecsize.ne.13) then
+             print*,' '
+             print*,'Select Species: CO2 CO O O(1D) O2 O3' 
+             print*,'                 1  2  3   4   5  6'
+             print*,'                 H H2 OH HO2 H2O2 N2 H2O'
+             print*,'                 7 8  9  10   11  12 13'
+             do n=1,varspecsize
+               print*,'Type number of species ',i
+               read(5,'(i)') varspec(n)
+             enddo
+           else
+             do n=1,varspecsize
+               varspec(n)=n
+             enddo
+           endif
+         endif
+       enddo
+      if(varoutsize.gt.6) print*,'Value must be <= 6'
+     
+c ***************** Fin partie a moderniser ***************
+
+! LOOP ON FILES
+! =================================================================
+      do ff=1,fichsize
+ 
+      file=nomfile(ff)  
+      nomfich=nomfile(ff)  
+      file=file(1:lnblnk(file))
+      PRINT*,'file',file
+
+c     Ouverture fichiers :
+c     ------------------
+      write(*,*) "opening "//trim(nomfich)//"..."
+      ierr = NF_OPEN(trim(adjustl(nomfich))//".nc",NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening file '//nomfich
+         stop ""
+      endif
+
+! Control & lecture on dimensions
+! =================================================================
+      ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+      ierr=NF_INQ_VARID(nid,"latitude",latvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <latitude> is missing'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+!  write(*,*) "latlen: ",latlen
+
+      ierr=NF_INQ_DIMID(nid,"longitude",londim)
+      ierr=NF_INQ_VARID(nid,"longitude",lonvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <longitude> is lacking'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+!  write(*,*) "lonlen: ",lonlen
+
+      ierr=NF_INQ_DIMID(nid,"altitude",altdim)
+      ierr=NF_INQ_VARID(nid,"altitude",altvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <altitude> is lacking'
+      stop ""
+      endif
+
+      ierr=NF_INQ_DIMLEN(nid,altdim,altlen)
+!  write(*,*) "altlen: ",altlen
+
+      if (ff.eq.1) then
+        allocate(lat(latlen))
+        allocate(lon(lonlen))
+        allocate(alt(altlen))
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid,latvar,lat)
+      ierr = NF_GET_VAR_DOUBLE(nid,lonvar,lon)
+      ierr = NF_GET_VAR_DOUBLE(nid,altvar,alt)
+#else
+      ierr = NF_GET_VAR_REAL(nid,latvar,lat)
+      ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
+      ierr = NF_GET_VAR_REAL(nid,altvar,alt)
+#endif
+
+c   Lecture Time :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+        PRINT*,'temps',(temps(itau),itau=1,10)
+! =================================================================
+
+! SETTING OUTPUT FILES
+
+      file=nomfileout(ff)  
+      nomfich=nomfileout(ff)  
+      file=file(1:lnblnk(file))
+
+c    layers in zareoid : ************
+          do l=1,llm
+            alt(l)=zaref(l)/1000.
+          enddo
+
+! =================================================================
+! Output in netcdf
+! =================================================================
+      if (sor.ne.2) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+ 
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_P.nc",
+     &                     NF_CLOBBER, nout)
+          if (ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                          "Pressure coordinates ")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_Z.nc",
+     &                     NF_CLOBBER, nout)
+          IF(ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                           "zaeroid coordinates")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude ", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        call def_var(nout,"Time","Time","days since 0000-00-0
+     &  00:00:00",1,(/timedimout/),timevarout,ierr)
+
+        ierr = NF_REDEF (nout)       
+        call def_var(nout,"latitude","latitude","degrees_north",1,
+     &               (/latdimout/),nvarid,ierr)
+
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lat)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lat)
+#endif
+        ierr = NF_REDEF (nout) 
+        call def_var(nout,"longitude","East longitude","degrees_east",1,
+     &               (/londimout/),nvarid,ierr)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lon)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lon)
+#endif
+        ierr = NF_REDEF (nout)
+
+        if(coor.ne.2) then 					! PRESSURE CCOORDINATES
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",22,"altitude
+     &                            pression")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"Pa")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',4,"down")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,pref)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,pref)
+#endif
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",20,"altitude
+     &                           zaeroid")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,alt)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,alt)
+#endif
+        endif
+
+      endif !end if netcdf  
+
+! Output in idl
+! =================================================================
+      if (sor.ne.1) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          do i=1,varoutsize
+            j=121+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_P_'
+     &               //trim(noms(iq))//'.dat'  
+                j=121+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq) 
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) pref
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_P_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i)) 
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) pref
+            endif
+          enddo 
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+          do i=1,varoutsize
+            j=1221+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_Z_'
+     &               //trim(noms(iq))//'.dat'  
+                j=1221+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq)
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) alt
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_Z_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i))
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) alt
+            endif
+          enddo
+              
+c              file=trim(nomfileout(ff))
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_EUV.dat',
+c     &               status='unknown')
+c              write(j,117) 'EUV'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_CON.dat',
+c     &               status='unknown')
+c              write(j,117) 'CONDUCTION'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_NIR.dat',
+c     &               status='unknown')
+c              write(j,117) 'NIR'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+        endif
+
+      endif
+120    format(3i3)
+119    format(12(e10.4,1x))
+118    format(2i3)
+117    format(6(a7))
+116    format(13(a6))
+! =================================================================
+ 
+
+800   continue ! LOOP SUR LES FICHIERS
+
+
+! =================================================================
+! INITIALIZATION OF PARAMETERS
+! =================================================================
+
+      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
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+
+      CALL readhead_NC(trim(adjustl(fdiag))//".nc",day0,phis,R)
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c     If needed : getting topography, albedo, thermal inertia...
+c     -------------------------------------------------------
+c     "phis" is the surface geopotential = topography (m) * g 
+       relief='mola'    ! Topography MOLA par defaut
+
+        CALL datareadnc(relief,phis,alb,ith,zmeaS,zstdS,zsigS,zgamS,
+      .          ztheS)
+
+
+! =================================================================
+! LOOP IN TIME
+! =================================================================
+
+      DO itau=1,nbpas
+
+! FILE READING : 
+! =================================================================
+        print*,'Timestep = ',itau,'/',nbpas
+
+c Cas special stats pour la base de donnee : FF 2004
+c        call lect_var(nid,'tsurf',3,ierr,itau,	tsurf)
+        call lect_var(nid,'ps',3,ierr,itau,ps)
+
+        call lect_var(nid,'temp',4,ierr,itau,t)
+        call lect_var(nid,'u',4,ierr,itau,u)
+        call lect_var(nid,'v',4,ierr,itau,v)
+        call lect_var(nid,'w',4,ierr,itau,		w)
+        call lect_var(nid,'rho',4,ierr,itau,	rho)
+        
+
+
+        do n=1,varspecsize
+          i=varspec(n)
+        call lect_var(nid,'n_'//trim(noms(i)),4,ierr,itau,spec)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              nspec(i,j,l,n)=spec(i,j,l)
+            enddo
+          enddo
+        enddo
+        enddo
+
+        if(fstats*ff-fichsize .eq. 0) then
+          call lect_var(nid,'temp_sd',4,ierr,itau,	t_sd)
+          call lect_var(nid,'u_sd',4,ierr,itau,		u_sd)
+          call lect_var(nid,'v_sd',4,ierr,itau,		v_sd)
+c          call lect_var(nid,'w_sd',4,ierr,itau,		w_sd)
+c          call lect_var(nid,'rho_sd',4,ierr,itau,	rho_sd)
+          do n=1,varspecsize
+            i=varspec(n)
+            call lect_var(nid,'n_'//trim(noms(i))//'_sd',4,ierr,
+     &                    itau,	spec)
+            do l=1,llm
+              do j=1,jjp1
+                do i=1,iip1
+                  nspec_sd(i,j,l,n)=spec(i,j,l)
+                enddo
+              enddo
+            enddo
+          enddo
+        endif
+
+! =================================================================
+! COMPUTING ALTITUDE OF GCM LEVELS IN GCM GRID
+! =================================================================
+
+c  ---------------------------------------------------------------
+c   Computing Molecular Gas Constant at every grid point (J kg-1 K-1)
+c   later used to integrate the hydrostatic equation
+c  ---------------------------------------------------------------
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+c              Rnew = P/(rho*T)
+              Rnew(i,j,l) =  (aps(l) + bps(l)*ps(i,j))
+     &                      / ( rho(i,j,l) * T(i,j,l) )
+            enddo
+          enddo
+        enddo
+
+
+c      ALTITUDE OF GCM LEVELS 
+c      ----------------------
+c      zlocal 	! altitude above the local surface (m)
+c      zareoid 	! altitude above the mola areoid (m)
+c      phis(i,j)/g ! altitude of the local surface above the mola areoid (m)
+
+        do j=1,jjp1
+          do i=1,iip1
+            sigij(1)=aps(1)/ps(i,j)+bps(1)
+            zlocal(i,j,1)=-log(sigij(1))* Rnew(i,j,1)*t(i,j,1)/g
+            zareoid(i,j,1) = zlocal(i,j,1) + phis(i,j)/g0
+
+            do l=2,llm
+              sigij(l)=aps(l)/ps(i,j)+bps(l)
+              tmean=t(i,j,l)
+              if(t(i,j,l).ne.t(i,j,l-1))
+     &          tmean=(t(i,j,l)-t(i,j,l-1))/log(t(i,j,l)/t(i,j,l-1))
+                Rmean = 0.5*(Rnew(i,j,l) + Rnew(i,j,l-1))
+                gz= g0*a0**2/(a0+zareoid(i,j,l-1))**2
+
+              zlocal(i,j,l)=zlocal(i,j,l-1) 
+     &                -log(sigij(l)/sigij(l-1))*Rmean*tmean/gz
+              zareoid(i,j,l) = zlocal(i,j,l) + phis(i,j)/g
+            enddo
+  
+          enddo
+        enddo
+
+
+c Local time
+c ----------
+c universal time (in stats oe MCD files)
+        utime = (itau-1)*2.
+
+c local time (in stats file)
+        DO i = 1,iim
+          localtime(i)=utime + 12.*rlonv(i)/pi
+          if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+          if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+        ENDDO
+
+c c Passage en niveaux de pression
+c ------------------------------
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+          call xsig2p (ps,w,pref,llm,wp)
+          call xsig2p (ps,rho,pref,llm,rhop)
+          do iq=1,varspecsize
+            call xsig2p (ps,nspec(1,1,1,iq),pref,llm,nspecp(1,1,1,iq))
+          enddo
+           if(fstats*ff-fichsize .eq. 0) then
+             call xsig2p (ps,u_sd,pref,llm,up_sd)
+             call xsig2p (ps,v_sd,pref,llm,vp_sd)
+             call xsig2p(ps,t_sd,pref,llm,Tp_sd)
+             call xsig2p (ps,w_sd,pref,llm,wp_sd)
+             call xsig2p (ps,rho_sd,pref,llm,rhop_sd)
+             do iq=1,varspecsize
+               call xsig2p (ps,nspec_sd(1,1,1,iq),pref,llm,
+     $                      nspecp_sd(1,1,1,iq))
+             enddo
+           endif
+         endif
+
+c c Passage en niveaux de zareoid
+c ------------------------------
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+        do j=1,jjp1
+          do i=1,iip1
+            do l=1,llm
+              Tij(l)=T(i,j,l)
+              uij(l)=u(i,j,l)
+              vij(l)=v(i,j,l)
+              wij(l)=w(i,j,l)
+              rhoij(l)=rho(i,j,l)
+              do iq=1,varspecsize
+                nspecij(l,iq)=nspec(i,j,l,iq)
+                if(l.eq.llm) nspecij(l+1,iq)=nspecij(l,iq)*1.e-3
+              enddo
+c              euvij(l)=euv(i,j,l)
+c              conij(l)=con(i,j,l)
+c              nirij(l)=nir(i,j,l)
+              zaij(l)=zareoid(i,j,l)
+              p_zaij(l)=exp(-zareoid(i,j,l)/1.e4) ! used to interpolate rho
+              if(fstats*ff-fichsize .eq. 0) then
+                Tij_sd(l)=T_sd(i,j,l)
+                uij_sd(l)=u_sd(i,j,l)
+                vij_sd(l)=v_sd(i,j,l)
+                wij_sd(l)=w_sd(i,j,l)
+                rhoij_sd(l)=rho_sd(i,j,l)
+                do iq=1,varspecsize
+                  nspecij_sd(l,iq)=nspec_sd(i,j,l,iq)
+                  if(l.eq.llm) nspecij_sd(l+1,iq)=nspecij_sd(l,iq)*1.e-3
+                enddo
+              endif
+            enddo
+
+            do l=1,llm
+              call interpolf(zaref(l),y,zaij,Tij,llm)
+              Ta(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,uij,llm)
+              ua(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,vij,llm)
+              va(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,wij,llm)
+              wa(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,euvij,llm)
+c              euva(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,conij,llm)
+c              cona(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,nirij,llm)
+c              nira(i,j,l)=y
+
+              p_zaref=exp(-zaref(l)/1.e4)
+              call interpolf(p_zaref,y,p_zaij,rhoij,llm+1)
+              rhoa(i,j,l)=y
+               
+              do iq=1,varspecsize
+                call interpolf(p_zaref,y,p_zaij,nspecij(1,iq),llm+1)
+c                call interpolf(zaref(l),y,zaij,nspecij(1,iq),llm)
+                nspeca(i,j,l,iq)=y
+              enddo
+
+              if(fstats*ff-fichsize .eq. 0) then
+                call interpolf(zaref(l),y,zaij,Tij_sd,llm)
+                Ta_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,uij_sd,llm)
+                ua_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,vij_sd,llm)
+                va_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,wij_sd,llm)
+                wa_sd(i,j,l)=y
+                call interpolf(p_zaref,y,p_zaij,rhoij_sd,llm+1)
+                rhoa_sd(i,j,l)=y
+                do iq=1,varspecsize
+                  call interpolf(p_zaref,y,p_zaij,nspecij_sd(1,iq),
+     &                           llm+1)
+c                  call interpolf(zaref(l),y,zaij,nspecij_sd(1,iq),llm)
+                  nspeca_sd(i,j,l,iq)=y
+                enddo
+              endif
+
+            enddo
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,T(32,24,l),Ta(32,24,l)
+c        print*,nspec(32,24,l,1),nspeca(32,24,l,1)
+c            enddo
+
+        endif
+ 
+c Output at each time-step, in netcdf format
+! =================================================================
+        if (sor .ne. 2) then
+
+          ierr= NF_INQ_VARID(nout,"Time",nvarid)
+#ifdef NC_DOUBLE
+          ierr= NF_PUT_VARA_DOUBLE(nout,nvarid,itau,1,temps(itau))
+#else
+          ierr= NF_PUT_VARA_REAL(nout,nvarid,itau,1,temps(itau))
+#endif
+          if (ierr.ne.NF_NOERR) then
+            write(*,*) "time problem ",NF_STRERROR(ierr)
+            stop
+          endif
+
+          if (varoutsize.eq.6) n=1
+          if (varoutsize.ne.6) n=varoutsize
+          do i=1,n
+            if(varout(i).eq.1 .or. varoutsize.eq.6) then
+             if(coor.ne.1) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Ta)
+             if(coor.ne.2) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Tp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Ta_sd)
+                if(coor.ne.2) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Tp_sd)
+              endif
+            endif
+            if(varout(i).eq.2 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,ua)
+              if(coor.ne.2) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,up)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,ua_sd)
+                if(coor.ne.2) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,up_sd)
+              endif
+            endif
+            if(varout(i).eq.3 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,va)
+              if(coor.ne.2) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,vp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,va_sd)
+                if(coor.ne.2) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,vp_sd)
+              endif
+            endif
+            if(varout(i).eq.4 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wa)
+              if(coor.ne.2) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wa_sd)
+                if(coor.ne.2) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wp_sd)
+              endif
+            endif
+            if(varout(i).eq.5 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhoa)
+              if(coor.ne.2) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhop)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhoa_sd)
+                if(coor.ne.2) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhop_sd)
+              endif
+            endif
+            if(varout(i).eq.6 .or. varoutsize.eq.6) then
+              do iq=1,varspecsize
+                j=varspec(iq)
+                if(coor.ne.1) call put_var(nout,'n_'//trim(noms(j)),
+     &       'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspeca(1,1,1,iq))
+                if(coor.ne.2) call put_var(nout,'n_'//trim(noms(j)),
+     &         'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspecp(1,1,1,iq))
+                if(fstats*ff-fichsize.eq.0) then
+                  if(coor.ne.1) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspeca_sd(1,1,1,iq))
+                  if(coor.ne.2) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspecp_sd(1,1,1,iq))
+                endif
+              enddo
+            endif     
+          enddo
+        endif !endif writing data on Netcdf file 
+
+c Output at each time-step, ASCII file for IDL
+! =================================================================
+c In pressure and zareoid coordinates:
+
+      if (sor .ne. 1) then
+       do n=1,varoutsize
+         if(varout(n).eq.1) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((Tp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((Ta(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.2) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((up(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1)then
+               k=1221+n
+               write(k,124) ((ua(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif 
+         if(varout(n).eq.3) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((vp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((va(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.4) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(122,124) ((wp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((wa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.5) then
+           do l=1,llm
+            if(coor.ne.2) then
+              k=121+n
+              write(k,124) ((rhop(i,j,l),i=1,iim),j=1,jjp1)
+            elseif(coor.ne.1) then
+               k=1221+n
+              write(k,124) ((rhoa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.6) then
+           do iq=1,varspecsize
+             do l=1,llm
+               if(coor.ne.1) then
+                 k=1221+n+(iq-1)
+                 write(k,124) ((nspeca(i,j,l,iq),i=1,iim),j=1,jjp1)
+               endif
+             enddo
+           enddo
+         endif     
+       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((euva(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((cona(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((nira(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+      endif
+124   format(12(e10.4,1x))
+
+
+       ENDDO		!LOOP in TIME
+! =================================================================
+
+ 900   continue
+
+
+c  ECRITURE FINALE si besoin
+c  *************************
+      ierr= NF_CLOSE(nid)
+      ierr=NF_CLOSE(nout)
+      close (33)
+      close (122)
+      close (1222)
+       
+      ENDDO		!LOOP in FILES
+! =================================================================
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
+
+c*******************************************************
+
+      subroutine  xsig2p (ps,qsig,pref,npref,qp)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Francois Forget    Avril 1996
+c
+c Cette subroutine calcule les champs interpole en niveaux de pression
+c different niveaux de pression pref
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+      REAL qsig(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1)
+      integer npref
+      real pref(npref)
+
+c outputs
+      REAL qp(iip1,jjp1,npref)
+
+
+c Variables du modele
+c -------------------
+
+      REAL lnp(llm)  , q(llm)
+      REAL x,y
+      INTEGER i,j,l ,n
+
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+ 
+#include "fxyprim.h"
+c**********************************************************************
+         if (firstcall) then
+           write(*,*) 'kappa = ', kappa
+           write(*,*) 'cpp = ', cpp
+           firstcall = .false.
+         end if
+
+        DO j=1,jjp1
+          DO i=1,iip1
+            do l=1,llm
+              lnp(l) = -log(aps(l)+bps(l)*ps(i,j))
+              q(l) = qsig(i,j,l)
+            end do
+            do n =1,npref
+              if ( (pref(n).le.ps(i,j)) .and.
+     &          (pref(n).ge.(ps(i,j)*bps(llm)+aps(llm))) ) then
+                    x = -log(pref(n))
+                    call interpolf(x,y,lnp,q,llm)
+                    qp(i,j,n) = y
+              else
+                    qp(i,j,n) = 1E+20 
+              end if
+            end do
+          ENDDO
+        ENDDO
+
+      return
+      end 
+
+      subroutine  missing_value(nout,nvarid,valid_range,missing)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+      include "netcdf.inc"
+
+      INTEGER nout,nvarid,ierr
+      REAL missing
+      REAL valid_range(2)
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+             ierr= NF_PUT_ATT_REAL(nout,nvarid,'valid_range',
+     $  NF_FLOAT,2,valid_range)
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: valid_range attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',
+     $  NF_DOUBLE,1,missing)
+#else
+              ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',
+     $  NF_FLOAT,1,missing)
+
+#endif
+
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: missing value attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+      return
+      end
+**********************************************************
+      subroutine lect_var(nid,name,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c inputs
+      character (len=*) :: name
+      INTEGER nid,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner
+c output var
+      integer, dimension(nbdim) :: var
+c  ---------
+        if (nbdim.eq.4) then
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+          ierr = NF_INQ_VARID (nid,adjustl(name), nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,corner,edges, var)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,corner,edges, var)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: reading failed for ', name
+            CALL abort
+          ENDIF
+
+      return
+      end
+
+
+      subroutine put_var(nout,name,title,units,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+      character (len=*) :: title,units,name
+      INTEGER nout,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner,id,var
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c  ---------
+        if (nbdim.eq.4) then
+         ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+         ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+         ierr= NF_INQ_DIMID(nout,"altitude",id(3))
+         ierr= NF_INQ_DIMID(nout,"Time",id(4))
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+             ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+             ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+             ierr= NF_INQ_DIMID(nout,"Time",id(3))
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+        ierr = NF_INQ_VARID (nout,adjustl(name), nvarid)
+          if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+! Creation de la variable si elle n'existait pas
+             write (*,*) "====================="
+             write (*,*) "creation de  ",name
+         call def_var(nout,adjustl(title),adjustl(name),adjustl(units),
+     $   nbdim,id,nvarid,ierr)
+          if (name.eq.'temp') then
+             ierr = NF_REDEF (nout)
+             call missing_value(nout,nvarid,valid_range,1E+20)
+             ierr = NF_ENDDEF(nout)
+          endif
+          endif
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nout,nvarid,corner,edges,var)
+#else
+        ierr = NF_PUT_VARA_REAL(nout,nvarid,corner,edges,var)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: writing failed for ',name
+            CALL abort
+        ENDIF
+
+                
+      return
+      end
+
+
+      Subroutine interpolf(x,y,xd,yd,nd)
+
+c******************************************************
+c   SUBROUTINE   (interpol)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+
+c  Version with CONSTANT values oustide limits
+c**********************************************************
+
+
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(*),yd(*)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+
+c run
+c ---
+c      y_undefined=-999.999
+      y_undefined=1.e20
+
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(1)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1)
+c       y = yd(nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+
+c     write (*,*)' x , y' , x,y
+c     do i=1,nd
+c       write (*,*)' i, xd , yd' , xd(i),yd(i)
+c     end do
+c     stop
+
+ 99   continue
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_stats-diag.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_stats-diag.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anl_stats-diag.F	(revision 46)
@@ -0,0 +1,1377 @@
+      PROGRAM anldiag_nc
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Program designed to read output files from the MARS gcm
+c or the Mars Climate database.
+c
+c    Francois Forget 1999
+c    Version used by monica to interpolate in zaeroid and p coordinate
+
+c
+c=======================================================================
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"
+
+      INTEGER itau,nbpas,nbpasmx, coor,sor,varoutsize
+      integer varspecsize
+      integer varout(6),varspec(nqmx)
+      integer itau0
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx),y
+      INTEGER unitlec
+      INTEGER i,j,l,irec,itautot,ierr,iq,n,ff,k
+      real, dimension(:),allocatable :: lat,lon,alt
+      integer:: nout,latdimout,londimout,altdimout,timedimout,timevarout
+      integer:: latdim,londim,altdim,dimid
+      integer:: latvar,lonvar,altvar,timevar
+      integer:: latlen,lonlen,altlen,timelen
+      integer, dimension(4) :: edges,corner,id
+      integer, dimension(3) :: edges2,corner2
+
+      INTEGER   unit,nvarid,nid,varid
+      REAL mugaz
+
+      REAL missing
+      PARAMETER(missing=1E+20)
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm),w(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),rho(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+      REAL Rnew(iip1,jjp1,llm)
+      real euv(iip1,jjp1,llm),con(iip1,jjp1,llm),nir(iip1,jjp1,llm)
+      real nspec(iip1,jjp1,llm,nqmx),spec(iip1,jjp1,llm)
+
+      REAL v_sd(iip1,jjp1,llm),u_sd(iip1,jjp1,llm)
+      real w_sd(iip1,jjp1,llm),t_sd(iip1,jjp1,llm)
+      real rho_sd(iip1,jjp1,llm)
+      real euv_sd(iip1,jjp1,llm),con_sd(iip1,jjp1,llm)
+      real nir_sd(iip1,jjp1,llm)
+      real nspec_sd(iip1,jjp1,llm,nqmx)
+
+c   ALtitude of the GCM levels (+1 dummy "thermosphere level")
+c   -------------------------
+      REAL zlocal(iip1,jjp1,llm+1) ! altitude above the local surface (m)
+      REAL zareoid(iip1,jjp1,llm+1) ! altitude above the mola areoid (m)
+      real tmean   ! use to integrate hydrostatic equation
+      real sig_therm ! dummy "thermosphere level" as in atmemcd.F
+      real T_therm
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm),wp(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm),rhop(iip1,jjp1,llm)
+      REAL nspecp(iip1,jjp1,llm,nqmx)
+      REAL phip(iip1,jjp1,llm)
+      
+      REAL vp_sd(iip1,jjp1,llm),up_sd(iip1,jjp1,llm)
+      real wp_sd(iip1,jjp1,llm),tp_sd(iip1,jjp1,llm)
+      real rhop_sd(iip1,jjp1,llm),nspecp_sd(iip1,jjp1,llm,nqmx)
+ 
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c    Version 32 layers : ************
+      data pref/
+     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04/
+
+c    Version 50 layers : ************
+c      data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02, 7.23328E-03, 3.61027E-03, 1.80193E-03,
+c     & 8.99364E-04,4.48881E-04, 2.15769E-04, 1.3E-04,
+c     & 7.23328e-05, 3.61027e-05, 1.80193e-05, 8.99364e-06,
+c     & 4.48881e-06, 2.15769e-06, 1.3e-06,
+c     & 7.23328e-07, 3.61027e-07, 1.80193e-07, 8.99364e-08,
+c     & 4.48881e-08, 2.15769e-08, 1.3e-08,
+c     & 7.23328e-09, 3.61027e-09, 1.80193e-09, 8.99364e-10/
+
+c      data pref/
+c     &1000.,884., 783. , 610., 475, 370, 288, 224, 174, 140.,
+c     &115 , 80.6481, 48.0445, 26.6881, 14.1462, 7.29102, 3.70004,
+c     &1.86241, 0.933516, 0.466924, 0.233296, 0.116503, 5.81631E-02,
+c     & 2.90335E-02,1.44919E-02 / 
+c       data pref/
+c     & 101.4369,94.4369,87.4369,80.4369,73.4369,66.4369,59.4369,52.4369,
+c     & 45.4369,38.4369,31.5527,25.0626,18.9666,13.5138,8.97780,
+c     & 5.54010,3.19040,1.73630,0.907000,0.460400,0.228200,0.109700,
+c     & 0.0500,0.0200,0.0050/
+c   variables meteo en coordonnee de zareoid
+c   --------------------------------------------
+      REAL va(iip1,jjp1,llm),ua(iip1,jjp1,llm),wa(iip1,jjp1,llm)
+      REAL ta(iip1,jjp1,llm),rhoa(iip1,jjp1,llm),ra(iip1,jjp1,llm)
+      real euva(iip1,jjp1,llm),cona(iip1,jjp1,llm),nira(iip1,jjp1,llm)
+      real nspeca(iip1,jjp1,llm,nqmx)
+
+      REAL va_sd(iip1,jjp1,llm),ua_sd(iip1,jjp1,llm)
+      real wa_sd(iip1,jjp1,llm),ta_sd(iip1,jjp1,llm)
+      real rhoa_sd(iip1,jjp1,llm)
+      real euva_sd(iip1,jjp1,llm),cona_sd(iip1,jjp1,llm)
+      real nira_sd(iip1,jjp1,llm)
+      real nspeca_sd(iip1,jjp1,llm,nqmx)
+
+      REAL vij(llm),uij(llm),zaij(llm),wij(llm),rij(llm)
+      REAL tij(llm),rhoij(llm+1),sigij(llm)
+      real euvij(llm),conij(llm),nirij(llm)
+      real nspecij(llm+1,nqmx)
+
+      REAL vij_sd(llm),uij_sd(llm)
+      real wij_sd(llm),tij_sd(llm),rhoij_sd(llm+1)
+      real euvij_sd(llm),conij_sd(llm),nirij_sd(llm)
+      real nspecij_sd(llm+1,nqmx)
+
+c     Niveaux de zareoide (m)
+      real zaref(llm)
+      real p_zaref,p_zaij(llm+1) ! used to interpolate rho
+
+c   Surface data (sometime needed for some analysis):
+c   ------------------------------------------------
+      character relief*3
+      real phis(iip1,jjp1)
+      real alb(iip1,jjp1),ith(iip1,jjp1)
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+
+      real utime
+      real localtime(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+      integer nmoy(jjp1,llm),tp1,tp2,pass
+
+      CHARACTER*1 yes,yescomp
+
+      integer iformat
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+      CHARACTER nomfile(2)*60,nomfileout(2)*60
+      integer fichsize,fstats
+      CHARACTER fdiag*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+      character*10  noms(nqmx),varnoms(6)
+      data          noms/"co2","co","o","o1d","o2","o3","h","h2",
+     $                   "oh","ho2","h2o2", "n2", "h2o"/
+      data          varnoms/"T","U","V","W","RHO","Species"/
+
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unitlec=11
+      itautot=0
+
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      print*,' ' 
+      PRINT*,'File to process: 1)DIAGFI 2)STATS 3)BOTH'
+      READ(5,'(i)') fichsize
+      if(fichsize.ne.2)then
+        i=1
+        PRINT*,'   enter name of diagfi file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        fdiag=nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+      endif
+      if(fichsize.ne.1)then
+        i=i+1
+        PRINT*,'   enter name of stats file (w/o .nc)'
+        READ(5,'(a)') nomfile(i)
+        PRINT*,'   do you want to rename the output file?  
+     &  1) Yes  2) No'
+        READ(5,'(i)') sor
+        if (sor.eq.1) then
+          PRINT*,'   enter label for output file'
+          READ(5,'(a)') nomfileout(i)
+        elseif(sor.eq.2) then
+          nomfileout(i)=nomfile(i)
+        endif
+        if(fichsize.eq.2) then
+          PRINT*,'   enter name of diagfi file for controle (w/o .nc)'
+          read(5,'(a)') fdiag
+        endif
+        fstats=1
+      endif
+      if (fichsize.ge.2) fichsize=fichsize-1
+      print*,' '
+      print*,'Output in: 1) netcdf 2) IDL 3) both ?'
+      READ(5,'(i)') sor
+      print*,' '
+      print*,'Coordinates in: 1) pressure 2) Zareoid 3) both  ?'
+      READ(5,'(i)') coor
+      print*,' '
+      print*,'Fields:  T  U  V  W  Rho  Species  All   ?'
+      print*,'Type total number of desired outputs or 6 for All   '
+      READ(5,'(i)') varoutsize
+      if(varoutsize.lt.6) then
+        print*,' '
+        print*,'Fields:  T  U  V  W  Rho  Species '
+        print*,'  #   :  1  2  3  4   5      6'
+        print*,' '
+        do i=1,varoutsize
+          print*,'Type number of variable ',i
+          READ(5,'(i)') varout(i)
+        enddo
+      endif
+      if(varoutsize.eq.6) then
+        do i=1,6
+          varout(i)=i
+        enddo
+      endif
+      do i=1,varoutsize
+        if (varout(i).eq.6) then
+           print*,'Type total number of desired species or 13 for All'
+           READ(5,'(i2)') varspecsize
+           if(varspecsize.ne.13) then
+             print*,' '
+             print*,'Select Species: CO2 CO O O(1D) O2 O3' 
+             print*,'                 1  2  3   4   5  6'
+             print*,'                 H H2 OH HO2 H2O2 N2 H2O'
+             print*,'                 7 8  9  10   11  12 13'
+             do n=1,varspecsize
+               print*,'Type number of species ',i
+               read(5,'(i)') varspec(n)
+             enddo
+           else
+             do n=1,varspecsize
+               varspec(n)=n
+             enddo
+           endif
+         endif
+       enddo
+      if(varoutsize.gt.6) print*,'Value must be <= 6'
+     
+
+! LOOP ON FILES
+! =================================================================
+      do ff=1,fichsize
+ 
+      file=nomfile(ff)  
+      nomfich=nomfile(ff)  
+      file=file(1:lnblnk(file))
+      PRINT*,'file',file
+
+c     Ouverture fichiers :
+c     ------------------
+      write(*,*) "opening "//trim(nomfich)//"..."
+      ierr = NF_OPEN(trim(adjustl(nomfich))//".nc",NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening file '//nomfich
+         stop ""
+      endif
+
+! Control & lecture on dimensions
+! =================================================================
+      ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+      ierr=NF_INQ_VARID(nid,"latitude",latvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <latitude> is missing'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+!  write(*,*) "latlen: ",latlen
+
+      ierr=NF_INQ_DIMID(nid,"longitude",londim)
+      ierr=NF_INQ_VARID(nid,"longitude",lonvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <longitude> is lacking'
+      stop ""
+      endif
+      ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+!  write(*,*) "lonlen: ",lonlen
+
+      ierr=NF_INQ_DIMID(nid,"altitude",altdim)
+      ierr=NF_INQ_VARID(nid,"altitude",altvar)
+      if (ierr.NE.NF_NOERR) then
+      write(*,*) 'ERROR: Field <altitude> is lacking'
+      stop ""
+      endif
+
+      ierr=NF_INQ_DIMLEN(nid,altdim,altlen)
+!  write(*,*) "altlen: ",altlen
+
+      if (ff.eq.1) then
+        allocate(lat(latlen))
+        allocate(lon(lonlen))
+        allocate(alt(altlen))
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid,latvar,lat)
+      ierr = NF_GET_VAR_DOUBLE(nid,lonvar,lon)
+      ierr = NF_GET_VAR_DOUBLE(nid,altvar,alt)
+#else
+      ierr = NF_GET_VAR_REAL(nid,latvar,lat)
+      ierr = NF_GET_VAR_REAL(nid,lonvar,lon)
+      ierr = NF_GET_VAR_REAL(nid,altvar,alt)
+#endif
+
+c   Lecture Time :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'anl_NC: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+        PRINT*,'temps',(temps(itau),itau=1,10)
+! =================================================================
+
+! SETTING OUTPUT FILES
+
+      file=nomfileout(ff)  
+      nomfich=nomfileout(ff)  
+      file=file(1:lnblnk(file))
+
+c    layers in zareoid : ************
+          do l=0,llm-1
+            zaref(l+1)=4500.*l
+            alt(l+1)=zaref(l+1)/1000.
+          enddo 
+
+! =================================================================
+! Output in netcdf
+! =================================================================
+      if (sor.ne.2) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+ 
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_P.nc",
+     &                     NF_CLOBBER, nout)
+          if (ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                          "Pressure coordinates ")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+          ierr = NF_CREATE(trim(adjustl(nomfich))//"_Z.nc",
+     &                     NF_CLOBBER, nout)
+          IF(ierr.NE.NF_NOERR) THEN
+            write(*,*)' Pb d''ouverture du fichier '
+            write(*,*)' ierr = ', ierr
+            STOP
+          ENDIF
+          ierr = NF_PUT_ATT_TEXT(nout, NF_GLOBAL, "title", 24,
+     &                           "zaeroid coordinates")
+          ierr = NF_DEF_DIM(nout,"latitude", size(lat), latdimout)
+          ierr = NF_DEF_DIM(nout,"longitude", size(lon), londimout)
+          ierr = NF_DEF_DIM(nout,"altitude ", size(pref), altdimout)
+          ierr = NF_DEF_DIM(nout,"Time", NF_UNLIMITED, timedimout)
+          ierr = NF_ENDDEF(nout)
+
+        endif
+
+        call def_var(nout,"Time","Time","days since 0000-00-0
+     &  00:00:00",1,(/timedimout/),timevarout,ierr)
+
+        ierr = NF_REDEF (nout)       
+        call def_var(nout,"latitude","latitude","degrees_north",1,
+     &               (/latdimout/),nvarid,ierr)
+
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lat)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lat)
+#endif
+        ierr = NF_REDEF (nout) 
+        call def_var(nout,"longitude","East longitude","degrees_east",1,
+     &               (/londimout/),nvarid,ierr)
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,lon)
+#else
+        ierr = NF_PUT_VAR_REAL (nout,nvarid,lon)
+#endif
+        ierr = NF_REDEF (nout)
+
+        if(coor.ne.2) then 					! PRESSURE CCOORDINATES
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",22,"altitude
+     &                            pression")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"Pa")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',4,"down")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,pref)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,pref)
+#endif
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES 
+
+#ifdef NC_DOUBLE
+          ierr = NF_DEF_VAR (nout,"altitude",NF_DOUBLE,1,
+     &                       (/altdimout/), nvarid)
+#else
+          ierr = NF_DEF_VAR (nout,"altitude",NF_FLOAT,1,
+     &                       (/altdimout/),nvarid)
+#endif
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",20,"altitude
+     &                           zaeroid")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km")
+          ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up")
+          ierr = NF_ENDDEF(nout)
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,alt)
+#else
+          ierr = NF_PUT_VAR_REAL (nout,nvarid,alt)
+#endif
+        endif
+
+      endif !end if netcdf  
+
+! Output in idl
+! =================================================================
+      if (sor.ne.1) then
+
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          do i=1,varoutsize
+            j=121+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_P_'
+     &               //trim(noms(iq))//'.dat'  
+                j=121+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq) 
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) pref
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_P_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i)) 
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) pref
+            endif
+          enddo 
+        endif
+
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+          do i=1,varoutsize
+            j=1221+i
+            if(varout(i).eq.6) then
+              do iq=1,varspecsize
+                file=trim(nomfileout(ff))//'_Z_'
+     &               //trim(noms(iq))//'.dat'  
+                j=1221+i+(iq-1)
+                open(j,file=trim(file), status='unknown')
+                write(j,117) noms(iq)
+                write(j,120) iim,jjp1,llm
+                write(j,119) lon
+                write(j,119) lat
+                write(j,119) alt
+              enddo
+            else
+              file=trim(nomfileout(ff))//'_Z_'
+     &            //trim(varnoms(varout(i)))//'.dat'  
+              open(j,file=trim(file), status='unknown')
+              write(j,117) varnoms(varout(i))
+              write(j,120) iim,jjp1,llm
+              write(j,119) lon
+              write(j,119) lat
+              write(j,119) alt
+            endif
+          enddo
+              
+c              file=trim(nomfileout(ff))
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_EUV.dat',
+c     &               status='unknown')
+c              write(j,117) 'EUV'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_CON.dat',
+c     &               status='unknown')
+c              write(j,117) 'CONDUCTION'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+c              j=j+1
+c              open(j,file=file(1:lnblnk(file))//'_Z_NIR.dat',
+c     &               status='unknown')
+c              write(j,117) 'NIR'
+c              write(j,120) iim,jjp1,llm
+c              write(j,119) lon
+c              write(j,119) lat
+c              write(j,119) alt
+        endif
+
+      endif
+120    format(3i3)
+119    format(12(e10.4,1x))
+118    format(2i3)
+117    format(6(a7))
+116    format(13(a6))
+! =================================================================
+ 
+
+800   continue ! LOOP SUR LES FICHIERS
+
+
+! =================================================================
+! INITIALIZATION OF PARAMETERS
+! =================================================================
+
+      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
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+
+      CALL readhead_NC(trim(adjustl(fdiag))//".nc",day0,phis,R)
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c  Dummy "thermosphere level" as in atmemcd (extrapol above top GCM level)
+      sig_therm=bps(llm)*exp(-20./7.)
+      T_therm = 200.  ! temperature (K) of the "thermosphere level"
+
+   
+c     If needed : getting topography, albedo, thermal inertia...
+c     -------------------------------------------------------
+c     "phis" is the surface geopotential = topography (m) * g 
+       relief='mola'    ! Topography MOLA par defaut
+
+c       CALL datareadnc(relief,phis,alb,ith,zmeaS,zstdS,zsigS,zgamS,
+c     .          ztheS)
+
+
+! =================================================================
+! LOOP IN TIME
+! =================================================================
+
+      DO itau=1,nbpas
+
+! FILE READING
+! =================================================================
+        print*,'Timestep = ',itau,'/',nbpas
+
+c        call lect_var(nid,'tsurf',3,ierr,itau,	tsurf)
+        call lect_var(nid,'ps',3,ierr,itau,		ps)
+
+        call lect_var(nid,'temp',4,ierr,itau,	t)
+        call lect_var(nid,'u',4,ierr,itau,		u)
+        call lect_var(nid,'v',4,ierr,itau,		v)
+c        call lect_var(nid,'w',4,ierr,itau,		w)
+c        call lect_var(nid,'rho',4,ierr,itau,	rho)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              Rnew(i,j,l)=8.314/mugaz*1.e3 
+! A enregistrer lors du run pour pouvoir le lire avec la ligne dessous
+            enddo
+          enddo
+        enddo
+c        call lect_var(nid,'r',4,ierr,itau,		Rnew)
+c        call lect_var(nid,'euv',4,ierr,itau,	euv)
+c        call lect_var(nid,'cond',4,ierr,itau,	con)
+c        call lect_var(nid,'nir',4,ierr,itau,	nir)
+        do n=1,varspecsize
+          i=varspec(n)
+        call lect_var(nid,'n_'//trim(noms(i)),4,ierr,itau,	spec)
+        do l=1,llm
+          do j=1,jjp1
+            do i=1,iip1
+              nspec(i,j,l,n)=spec(i,j,l)
+            enddo
+          enddo
+        enddo
+        enddo
+
+        if(fstats*ff-fichsize .eq. 0) then
+          call lect_var(nid,'temp_sd',4,ierr,itau,	t_sd)
+          call lect_var(nid,'u_sd',4,ierr,itau,		u_sd)
+          call lect_var(nid,'v_sd',4,ierr,itau,		v_sd)
+c          call lect_var(nid,'w_sd',4,ierr,itau,		w_sd)
+c          call lect_var(nid,'rho_sd',4,ierr,itau,	rho_sd)
+          do n=1,varspecsize
+            i=varspec(n)
+            call lect_var(nid,'n_'//trim(noms(i))//'_sd',4,ierr,
+     &                    itau,	spec)
+            do l=1,llm
+              do j=1,jjp1
+                do i=1,iip1
+                  nspec_sd(i,j,l,n)=spec(i,j,l)
+                enddo
+              enddo
+            enddo
+          enddo
+        endif
+! =================================================================
+
+! COMPUTING ALTITUDE OF GCM LEVELS IN GCM GRID
+! =================================================================
+c      zlocal 	! altitude above the local surface (m)
+c      zareoid 	! altitude above the mola areoid (m)
+
+        do j=1,jjp1
+          do i=1,iip1
+            sigij(1)=aps(1)/ps(i,j)+bps(1)
+            zlocal(i,j,1)=-log(sigij(1))* Rnew(i,j,1)*t(i,j,1)/g
+c            phis(i,j)=0.0
+c            phi(i,j,1)=phis(i,j)
+c            rho(i,j,1)=sigij(1)*ps(i,j)/(Rnew(i,j,1)*t(i,j,1))
+            zareoid(i,j,1) = zlocal(i,j,1) + phis(i,j)/g
+            do l=2,llm
+              sigij(l)=aps(l)/ps(i,j)+bps(l)
+              tmean=t(i,j,l)
+              if(t(i,j,l).ne.t(i,j,l-1))
+     &          tmean=(t(i,j,l)-t(i,j,l-1))/log(t(i,j,l)/t(i,j,l-1))
+              zlocal(i,j,l)=zlocal(i,j,l-1) 
+     &                -log(sigij(l)/sigij(l-1))*Rnew(i,j,l-1)*tmean/g
+              zareoid(i,j,l) = zlocal(i,j,l) + phis(i,j)/g
+c              rho(i,j,l)=sigij(l)*ps(i,j)/(Rnew(i,j,l)*t(i,j,l))
+              phi(i,j,l)=zareoid(i,j,l)*g
+            enddo
+  
+c           Altitude of the dummy thermosphere level (as in atmemcd)   
+c           ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+            tmean=(T_therm-t(i,j,llm))/log(T_therm/t(i,j,llm))
+            zlocal(i,j,llm+1)=zlocal(i,j,llm) 
+     &                  -log(sig_therm/sigij(llm))*Rnew(i,j,llm)*tmean/g
+            zareoid(i,j,llm+1) = zlocal(i,j,llm+1) + phis(i,j)/g
+
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,zareoid(32,24,l),zlocal(32,24,l),zaref(l)
+c        print*,zareoid(32,24,l),zaref(l)
+c            enddo
+
+c Local time
+c ----------
+c universal time (in stats oe MCD files)
+        utime = (itau-1)*2.
+
+c local time (in stats file)
+        DO i = 1,iim
+          localtime(i)=utime + 12.*rlonv(i)/pi
+          if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+          if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+        ENDDO
+
+c c Passage en niveaux de pression
+c ------------------------------
+        if(coor.ne.2) then 					! PRESSURE COORDINATES
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+          call xsig2p (ps,w,pref,llm,wp)
+          call xsig2p (ps,rho,pref,llm,rhop)
+          do iq=1,varspecsize
+            call xsig2p (ps,nspec(1,1,1,iq),pref,llm,nspecp(1,1,1,iq))
+          enddo
+           if(fstats*ff-fichsize .eq. 0) then
+             call xsig2p (ps,u_sd,pref,llm,up_sd)
+             call xsig2p (ps,v_sd,pref,llm,vp_sd)
+             call xsig2p(ps,t_sd,pref,llm,Tp_sd)
+             call xsig2p (ps,w_sd,pref,llm,wp_sd)
+             call xsig2p (ps,rho_sd,pref,llm,rhop_sd)
+             do iq=1,varspecsize
+               call xsig2p (ps,nspec_sd(1,1,1,iq),pref,llm,
+     $                      nspecp_sd(1,1,1,iq))
+             enddo
+           endif
+         endif
+
+c c Passage en niveaux de zareoid
+c ------------------------------
+        if(coor.ne.1) then 					! ZAEROID COORDINATES
+        do j=1,jjp1
+          do i=1,iip1
+            do l=1,llm
+              Tij(l)=T(i,j,l)
+              uij(l)=u(i,j,l)
+              vij(l)=v(i,j,l)
+              wij(l)=w(i,j,l)
+              rhoij(l)=rho(i,j,l)
+              do iq=1,varspecsize
+                nspecij(l,iq)=nspec(i,j,l,iq)
+                if(l.eq.llm) nspecij(l+1,iq)=nspecij(l,iq)*1.e-3
+              enddo
+c              euvij(l)=euv(i,j,l)
+c              conij(l)=con(i,j,l)
+c              nirij(l)=nir(i,j,l)
+              zaij(l)=zareoid(i,j,l)
+              p_zaij(l)=exp(-zareoid(i,j,l)/1.e4) ! used to interpolate rho
+              if(fstats*ff-fichsize .eq. 0) then
+                Tij_sd(l)=T_sd(i,j,l)
+                uij_sd(l)=u_sd(i,j,l)
+                vij_sd(l)=v_sd(i,j,l)
+                wij_sd(l)=w_sd(i,j,l)
+                rhoij_sd(l)=rho_sd(i,j,l)
+                do iq=1,varspecsize
+                  nspecij_sd(l,iq)=nspec_sd(i,j,l,iq)
+                  if(l.eq.llm) nspecij_sd(l+1,iq)=nspecij_sd(l,iq)*1.e-3
+                enddo
+              endif
+            enddo
+            p_zaij(l+1)=exp(-zareoid(i,j,l+1)/1.e4) 
+c            rhoij(l+1)=sig_therm*ps(i,j)/(R*T_therm)!in dummy thermosphere
+            rhoij(l+1)=rhoij(llm)*1.e-3
+            rhoij_sd(l+1)=rhoij_sd(llm)*1.e-3
+
+            do l=1,llm
+              call interpolf(zaref(l),y,zaij,Tij,llm)
+              Ta(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,uij,llm)
+              ua(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,vij,llm)
+              va(i,j,l)=y
+              call interpolf(zaref(l),y,zaij,wij,llm)
+              wa(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,euvij,llm)
+c              euva(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,conij,llm)
+c              cona(i,j,l)=y
+c              call interpolf(zaref(l),y,zaij,nirij,llm)
+c              nira(i,j,l)=y
+
+              p_zaref=exp(-zaref(l)/1.e4)
+              call interpolf(p_zaref,y,p_zaij,rhoij,llm+1)
+              rhoa(i,j,l)=y
+               
+              do iq=1,varspecsize
+                call interpolf(p_zaref,y,p_zaij,nspecij(1,iq),llm+1)
+c                call interpolf(zaref(l),y,zaij,nspecij(1,iq),llm)
+                nspeca(i,j,l,iq)=y
+              enddo
+
+              if(fstats*ff-fichsize .eq. 0) then
+                call interpolf(zaref(l),y,zaij,Tij_sd,llm)
+                Ta_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,uij_sd,llm)
+                ua_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,vij_sd,llm)
+                va_sd(i,j,l)=y
+                call interpolf(zaref(l),y,zaij,wij_sd,llm)
+                wa_sd(i,j,l)=y
+                call interpolf(p_zaref,y,p_zaij,rhoij_sd,llm+1)
+                rhoa_sd(i,j,l)=y
+                do iq=1,varspecsize
+                  call interpolf(p_zaref,y,p_zaij,nspecij_sd(1,iq),
+     &                           llm+1)
+c                  call interpolf(zaref(l),y,zaij,nspecij_sd(1,iq),llm)
+                  nspeca_sd(i,j,l,iq)=y
+                enddo
+              endif
+
+            enddo
+          enddo
+        enddo
+
+c            do l=1,llm
+c        print*,T(32,24,l),Ta(32,24,l)
+c        print*,nspec(32,24,l,1),nspeca(32,24,l,1)
+c            enddo
+
+        endif
+ 
+c Output at each time-step, in netcdf format
+! =================================================================
+        if (sor .ne. 2) then
+
+          ierr= NF_INQ_VARID(nout,"Time",nvarid)
+#ifdef NC_DOUBLE
+          ierr= NF_PUT_VARA_DOUBLE(nout,nvarid,itau,1,temps(itau))
+#else
+          ierr= NF_PUT_VARA_REAL(nout,nvarid,itau,1,temps(itau))
+#endif
+          if (ierr.ne.NF_NOERR) then
+            write(*,*) "time problem ",NF_STRERROR(ierr)
+            stop
+          endif
+
+          if (varoutsize.eq.6) n=1
+          if (varoutsize.ne.6) n=varoutsize
+          do i=1,n
+            if(varout(i).eq.1 .or. varoutsize.eq.6) then
+             if(coor.ne.1) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Ta)
+             if(coor.ne.2) 
+     &          call put_var(nout,'temp','temp','K',4,ierr,itau,Tp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Ta_sd)
+                if(coor.ne.2) call put_var(nout,'temp_sd','temp_sd','K',
+     &                                      4,ierr,itau,Tp_sd)
+              endif
+            endif
+            if(varout(i).eq.2 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,ua)
+              if(coor.ne.2) 
+     &          call put_var(nout,'u','u','m s-1',4,ierr,itau,up)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,ua_sd)
+                if(coor.ne.2) call put_var(nout,'u_sd','u_sd','m s-1',
+     &                                      4,ierr,itau,up_sd)
+              endif
+            endif
+            if(varout(i).eq.3 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,va)
+              if(coor.ne.2) 
+     &          call put_var(nout,'v','v','m s-1',4,ierr,itau,vp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,va_sd)
+                if(coor.ne.2) call put_var(nout,'v_sd','v_sd','m s-1',
+     &                                      4,ierr,itau,vp_sd)
+              endif
+            endif
+            if(varout(i).eq.4 .or. varoutsize.eq.6) then
+              if(coor.ne.1) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wa)
+              if(coor.ne.2) 
+     &          call put_var(nout,'w','w','m s-1',4,ierr,itau,wp)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wa_sd)
+                if(coor.ne.2) call put_var(nout,'w_sd','w_sd','m s-1',
+     &                                      4,ierr,itau,wp_sd)
+              endif
+            endif
+            if(varout(i).eq.5 .or. varoutsize.eq.6)  then
+              if(coor.ne.1) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhoa)
+              if(coor.ne.2) call put_var(nout,'rho','rho','',4,ierr,
+     &                                    itau,rhop)
+              if(fstats*ff-fichsize.eq.0) then
+                if(coor.ne.1) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhoa_sd)
+                if(coor.ne.2) call put_var(nout,'rho_sd','rho_sd','',
+     &                                      4,ierr,itau,rhop_sd)
+              endif
+            endif
+            if(varout(i).eq.6 .or. varoutsize.eq.6) then
+              do iq=1,varspecsize
+                j=varspec(iq)
+                if(coor.ne.1) call put_var(nout,'n_'//trim(noms(j)),
+     &       'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspeca(1,1,1,iq))
+                if(coor.ne.2) call put_var(nout,'n_'//trim(noms(j)),
+     &         'n_'//trim(noms(j)),'cm-3',4,ierr,itau,nspecp(1,1,1,iq))
+                if(fstats*ff-fichsize.eq.0) then
+                  if(coor.ne.1) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspeca_sd(1,1,1,iq))
+                  if(coor.ne.2) call put_var(nout,
+     &                        'n_'//trim(noms(j))//'_sd',
+     &                        'n_'//trim(noms(j))//'_sd','cm-3',4,ierr,
+     &                           itau,nspecp_sd(1,1,1,iq))
+                endif
+              enddo
+            endif     
+          enddo
+        endif !endif writing data on Netcdf file 
+
+c Output at each time-step, ASCII file for IDL
+! =================================================================
+c In pressure and zareoid coordinates:
+
+      if (sor .ne. 1) then
+       do n=1,varoutsize
+         if(varout(n).eq.1) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((Tp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((Ta(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.2) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((up(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1)then
+               k=1221+n
+               write(k,124) ((ua(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif 
+         if(varout(n).eq.3) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(k,124) ((vp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((va(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.4) then
+           do l=1,llm
+             if(coor.ne.2) then
+               k=121+n
+               write(122,124) ((wp(i,j,l),i=1,iim),j=1,jjp1)
+             elseif(coor.ne.1) then
+               k=1221+n
+               write(k,124) ((wa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.5) then
+           do l=1,llm
+            if(coor.ne.2) then
+              k=121+n
+              write(k,124) ((rhop(i,j,l),i=1,iim),j=1,jjp1)
+            elseif(coor.ne.1) then
+               k=1221+n
+              write(k,124) ((rhoa(i,j,l),i=1,iim),j=1,jjp1)
+             endif
+           enddo
+         endif
+         if(varout(n).eq.6) then
+           do iq=1,varspecsize
+             do l=1,llm
+               if(coor.ne.1) then
+                 k=1221+n+(iq-1)
+                 write(k,124) ((nspeca(i,j,l,iq),i=1,iim),j=1,jjp1)
+               endif
+             enddo
+           enddo
+         endif     
+       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((euva(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((cona(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+c       k=k+1
+c       do l=1,llm
+c         if(coor.ne.1)write(k,124) ((nira(i,j,l),i=1,iim),j=1,jjp1)
+c       enddo
+      endif
+124   format(12(e10.4,1x))
+
+
+       ENDDO		!LOOP in TIME
+! =================================================================
+
+ 900   continue
+
+
+c  ECRITURE FINALE si besoin
+c  *************************
+      ierr= NF_CLOSE(nid)
+      ierr=NF_CLOSE(nout)
+      close (33)
+      close (122)
+      close (1222)
+       
+      ENDDO		!LOOP in FILES
+! =================================================================
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
+
+c*******************************************************
+
+      subroutine  xsig2p (ps,qsig,pref,npref,qp)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Francois Forget    Avril 1996
+c
+c Cette subroutine calcule les champs interpole en niveaux de pression
+c different niveaux de pression pref
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+      REAL qsig(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1)
+      integer npref
+      real pref(npref)
+
+c outputs
+      REAL qp(iip1,jjp1,npref)
+
+
+c Variables du modele
+c -------------------
+
+      REAL lnp(llm)  , q(llm)
+      REAL x,y
+      INTEGER i,j,l ,n
+
+
+      logical firstcall
+      save firstcall
+      data firstcall/.true./
+ 
+#include "fxyprim.h"
+c**********************************************************************
+         if (firstcall) then
+           write(*,*) 'kappa = ', kappa
+           write(*,*) 'cpp = ', cpp
+           firstcall = .false.
+         end if
+
+        DO j=1,jjp1
+          DO i=1,iip1
+            do l=1,llm
+              lnp(l) = -log(aps(l)+bps(l)*ps(i,j))
+              q(l) = qsig(i,j,l)
+            end do
+            do n =1,npref
+              if ( (pref(n).le.ps(i,j)) .and.
+     &          (pref(n).ge.(ps(i,j)*bps(llm)+aps(llm))) ) then
+                    x = -log(pref(n))
+                    call interpolf(x,y,lnp,q,llm)
+                    qp(i,j,n) = y
+              else
+                    qp(i,j,n) = 1E+20 
+              end if
+            end do
+          ENDDO
+        ENDDO
+
+      return
+      end 
+
+      subroutine  missing_value(nout,nvarid,valid_range,missing)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+      include "netcdf.inc"
+
+      INTEGER nout,nvarid,ierr
+      REAL missing
+      REAL valid_range(2)
+c
+c  ARGUMENTS
+c  ---------
+
+c Inputs:
+      
+             ierr= NF_PUT_ATT_REAL(nout,nvarid,'valid_range',
+     $  NF_FLOAT,2,valid_range)
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: valid_range attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',
+     $  NF_DOUBLE,1,missing)
+#else
+              ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',
+     $  NF_FLOAT,1,missing)
+
+#endif
+
+        IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'anl_NC: missing value attribution failed'
+            WRITE(*,*) 'NF_NOERR', NF_NOERR
+            CALL abort
+        ENDIF
+      return
+      end
+**********************************************************
+      subroutine lect_var(nid,name,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c inputs
+      character (len=*) :: name
+      INTEGER nid,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner
+c output var
+      integer, dimension(nbdim) :: var
+c  ---------
+        if (nbdim.eq.4) then
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+          ierr = NF_INQ_VARID (nid,adjustl(name), nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,corner,edges, var)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,corner,edges, var)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: reading failed for ', name
+            CALL abort
+          ENDIF
+
+      return
+      end
+
+
+      subroutine put_var(nout,name,title,units,nbdim,ierr,itau,
+     $ var)
+      IMPLICIT NONE
+c=======================================================================
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+
+      character (len=*) :: title,units,name
+      INTEGER nout,nbdim,nvarid,ierr,itau
+      integer, dimension(nbdim) :: edges,corner,id,var
+      REAL valid_range(2)
+      DATA valid_range /0., 300.0/
+c  ---------
+        if (nbdim.eq.4) then
+         ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+         ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+         ierr= NF_INQ_DIMID(nout,"altitude",id(3))
+         ierr= NF_INQ_DIMID(nout,"Time",id(4))
+         corner=(/1,1,1,itau/)
+         edges=(/iip1,jjp1,llm,1/)
+        endif
+
+        if (nbdim.eq.3) then
+             ierr= NF_INQ_DIMID(nout,"longitude",id(1))
+             ierr= NF_INQ_DIMID(nout,"latitude",id(2))
+             ierr= NF_INQ_DIMID(nout,"Time",id(3))
+            corner=(/1,1,itau/)
+            edges=(/iip1,jjp1,1/)
+        endif
+
+
+        ierr = NF_INQ_VARID (nout,adjustl(name), nvarid)
+          if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+! Creation de la variable si elle n'existait pas
+             write (*,*) "====================="
+             write (*,*) "creation de  ",name
+         call def_var(nout,adjustl(title),adjustl(name),adjustl(units),
+     $   nbdim,id,nvarid,ierr)
+          if (name.eq.'temp') then
+             ierr = NF_REDEF (nout)
+             call missing_value(nout,nvarid,valid_range,1E+20)
+             ierr = NF_ENDDEF(nout)
+          endif
+          endif
+#ifdef NC_DOUBLE
+        ierr = NF_PUT_VARA_DOUBLE(nout,nvarid,corner,edges,var)
+#else
+        ierr = NF_PUT_VARA_REAL(nout,nvarid,corner,edges,var)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+            write(*,*) 'anl_NC: writing failed for ',name
+            CALL abort
+        ENDIF
+
+                
+      return
+      end
+
+
+      Subroutine interpolf(x,y,xd,yd,nd)
+
+c******************************************************
+c   SUBROUTINE   (interpol)
+c interpolation, give y = f(x) with array xd,yd known, size nd
+
+c  Version with CONSTANT values oustide limits
+c**********************************************************
+
+
+c Variable declaration
+c --------------------
+c  Arguments :
+      real x,y
+      real xd(*),yd(*)
+      integer nd
+c  internal
+      integer i,j
+      real y_undefined
+
+c run
+c ---
+c      y_undefined=-999.999
+      y_undefined=1.e20
+
+      y=0.
+      if ((x.le.xd(1)).and.(x.le.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(1)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(nd)
+      else if ((x.ge.xd(1)).and.(x.ge.xd(nd))) then
+        if (xd(1).lt.xd(nd)) y = y_undefined ! yd(nd)
+        if (xd(1).ge.xd(nd)) y = y_undefined ! yd(1)
+c       y = yd(nd)
+      else
+        do i=1,nd-1
+         if ( ( (x.ge.xd(i)).and.(x.lt.xd(i+1)) )
+     &     .or. ( (x.le.xd(i)).and.(x.gt.xd(i+1)) ) ) then
+           y=yd(i)+(x-xd(i))*(yd(i+1)-yd(i))/(xd(i+1)-xd(i))
+           goto 99
+         end if
+        end do
+      end if
+
+c     write (*,*)' x , y' , x,y
+c     do i=1,nd
+c       write (*,*)' i, xd , yd' , xd(i),yd(i)
+c     end do
+c     stop
+
+ 99   continue
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anldoppler2.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anldoppler2.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/anldoppler2.F	(revision 46)
@@ -0,0 +1,380 @@
+      PROGRAM anldoppler2
+      IMPLICIT NONE
+c======================================================================
+c
+c
+c Programme pour analyser vent a heure locale fixee
+c a partir d'un fichier Netcdf de la MCD
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+
+
+      INTEGER point
+      PARAMETER(point=11)     		! nbre de points d''observation
+      real olon(point),olat(point)	! Coordonnees des points observes
+      INTEGER iraie                	! pour le choix de la raie du CO
+
+c--------------------------------------------------------
+c coordonees lon/lat des points observes
+c--------------------------------------------------------
+
+c     ANNEE 2001
+
+      DATA olon/0,-30,30,0,-90,90,-75,75,0,-70,70/
+      DATA olat/-1,0,0,40,0,0,40,40,90,-40,40/
+
+c     ANNEE 1999
+
+c      DATA olon/0,0,-30,30,-85,85,0,-90,90,0,-65,65,0/
+c      DATA olat/18,-10,0,0,0,0,55,40,40,90,-40,-40,-70/
+
+c     ANNEE 1997
+
+c      DATA olon/0,-85,85,0,0/
+c      DATA olat/24,0,0,90,-70/
+
+c     ANNEE 1992
+
+c      DATA olon/0,-85,85,0,0,-75,75,-90,90,0,0/
+c      DATA olat/8,0,0,-40,40,-40,-40,40,40,90,-90/
+
+c     ANNEE 1990
+
+c      DATA olon/0,-90,90,0,0/
+c      DATA olat/-1,0,0,70,-90/
+
+c     ANNEE 1988
+
+c      DATA olon/0,-90,90,0,0,0,-35,35,0,0,-45,45,-60,60/
+c      DATA olat/-21,0,0,-90,60,0,0,0,-35,25,-35,-35,25,25/
+
+c----------------------------------------------------------
+
+      INTEGER mcdreadnc
+      external mcdreadnc
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,itautot
+
+c   Declarations DRS:
+c   -----------------
+      INTEGER ierr, dimtype
+      CHARACTER*120 dimsou, dimnam*16, dimtit*80
+      CHARACTER*40 dimunit
+      CHARACTER*100  varname
+
+c   variables meteo dans la grille verticale GCM
+c   --------------------------------------------
+      REAL v(iip1,jjp1,llm),u(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm)
+      REAL ps(iip1,jjp1) , tsurf(iip1,jjp1)
+
+c   variables meteo en coordonnee de pression
+c   --------------------------------------------
+      REAL vp(iip1,jjp1,llm),up(iip1,jjp1,llm)
+      REAL tp(iip1,jjp1,llm)
+
+c     Niveaux de pression (Pa)
+      real pref(llm)
+
+c     version 25 couches
+
+c      data pref/1291.37,1005.720,783.255,600.,475.069,350.,
+c     &          288.144,174.768,106.002,64.2935,38.9960,
+c     &          23.6523,14.3458,8.70000,5.28000,3.20000,
+c     &          1.94000,1.18000,0.714000,0.433000,0.263000,
+c     &          0.118000,0.0614000,0.0333000,0.0163000/
+
+c     version 32 couches
+
+      data pref/1291.37,1005.720,783.255,600.,475.069,350.,
+     &          288.144,174.768,106.002,64.2935,38.9960,
+     &          23.6523,14.3458,8.70000,5.28000,3.20000,
+     &          1.94000,1.18000,0.714000,0.433000,0.263000,
+     &          0.118000,0.0614000,0.0333000,0.0163000, 
+     &          8.e-3,4.e-3,2.e-3,1.e-3,5.e-4,2.e-4,1.e-4/
+
+c   Local:
+c   ------
+      REAL phis(iip1,jjp1)
+      real utime,latst,lonst,tamp,hlst
+      real localtime(iip1),heure(iip1)
+      common/temporaire/localtime
+
+      INTEGER*4 day0
+c      integer nmoy(jjp1,llm),tp1,tp2,pass
+	
+
+      CHARACTER*1 yes
+
+      LOGICAL ldrs
+      integer iformat,nid
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER nomfich*60
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+      logical icdf,idrs
+
+c   Dust
+c   ----
+
+#include "fxyprim.h"
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      ldrs=.true.
+      unitlec=11
+      itautot=0
+      idrs=.false.
+      icdf=.false.
+
+c     Lecture du fichier a lire
+c     -------------------------
+
+      PRINT*,'entrer le nom du fichier NetCDF de la MCD'
+      READ(5,'(a)') nomfich
+      file=nomfich(1:lnblnk(nomfich))
+      PRINT*,'file',file
+
+
+c     Lecture des autres parametres du programme
+c     ------------------------------------------
+
+      write(*,*) 'Raie a simuler ? '
+      write(*,*)'[1]12CO(2-1) [2]:13CO(2-1) ',
+     &     ' [3]:12CO(1-0) [4]13CO(1-0) [5]H2O(183)'  
+      read(*,*) iraie
+
+      write(*,*) 'heure local du point subterrestre ? '
+      read(*,*) hlst
+
+      write(*,*) 'latitude du point subterrestre ? '
+      read(*,*) latst
+
+c---------------------------------------------------------
+c   Lecture des fichiers stats , diagfi ou histmoy
+c---------------------------------------------------------
+
+800   continue ! LOOP SUR LES FICHIERS
+
+c     Ouverture fichiers :
+c     ------------------
+
+c        Ouverture fichier NetCDF
+            ierr = NF_OPEN (file(1:lnblnk(file))//'.nc', NF_NOWRITE,nid)
+            IF (ierr.NE.NF_NOERR) THEN
+              write(6,*)' Pb d''ouverture du fichier ',file
+              write(6,*)' ierr = ', ierr
+              CALL abort
+            ENDIF
+     
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+c initialisations aux valeurs martiennes
+
+      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
+      kappa=.256793             ! = r/cp  ~0.256793
+      r = 191.18213
+      pi=2.*asin(1.)
+      ecritphy =1
+      iphysiq=1
+      day_ini=0.
+      day_step=1
+   
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+c   sigma aux niveaux s:
+
+      DO l=1,llm
+         print*,'sig_s(',l,')  =  ',sig_s(l)
+      ENDDO
+
+c      Format Grads (Stats) : On suppose que l'on a 12 pas de temps :
+c      --------------------
+
+      nbpas=12
+      print*,'nbpas=',nbpas
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+
+       itau= 1
+
+801    continue ! LOOP SUR LES PAS DE TEMPS START HERE
+
+       varname='u'
+       ierr =mcdreadnc(nid,varname,llm,u,itau)
+       varname='v'
+       ierr =mcdreadnc(nid,varname,llm,v,itau)
+       varname='temp'
+       ierr =mcdreadnc(nid,varname,llm,t,itau)
+       varname='ps'
+       ierr =mcdreadnc(nid,varname,1,ps,itau)
+c      PRINT*,'ps',ps(iip1/2,jjp1/2)
+       varname='tsurf'
+       ierr =mcdreadnc(nid,varname,1,tsurf,itau)
+c      PRINT*,'tsurf',tsurf(iip1/2,jjp1/2)
+
+c**********************************************************
+c  Traitement des donnees : (we are in LOOP on timestep)
+c**********************************************************
+
+
+c universal time (in stats file)
+c-------------------------------
+      utime = (itau-1)*2.
+
+c Longitude du point subterrestre
+c -------------------------------
+
+      tamp=(hlst-utime)*(iip1/24.)
+      if(tamp.GT.iip1) then
+      tamp=tamp-iip1
+      endif
+      if(tamp.LT.0)  then
+      tamp=iip1+tamp
+      endif
+      lonst=rlonv(nint(tamp))*180./pi
+      write(*,*) hlst,latst,lonst
+
+       lonst=(hlst-utime)*15
+       if(lonst.gt.180) lonst=lonst-180.
+       if(lonst.lt.-180) lonst=lonst+180.
+       write(*,*) hlst,latst,lonst
+
+c Local time
+c ----------
+
+c local time (in stats file)
+            DO i = 1,iim
+              localtime(i)=utime + 12.*rlonv(i)/pi
+              if(localtime(i).gt.24) localtime(i)=localtime(i)-24.
+              if(localtime(i).lt.0) localtime(i)=localtime(i)+24.
+	      heure(i)=localtime(i)
+c	      if(itau.EQ.1) heure(i)=0.375*(i-1)
+c	      if(itau.EQ.1) print*,heure(i)
+            ENDDO
+
+c              if(itau.EQ.1) heure(iip1)=24.
+	       heure(iip1)=localtime(1)
+
+c ******************************************
+
+
+c c Passage en niveaux de pression
+c --------------------------------
+
+          call xsig2p (ps,T,pref,llm,Tp)
+          call xsig2p (ps,u,pref,llm,up)
+          call xsig2p (ps,v,pref,llm,vp)
+
+c         Test temporaire
+c          do l=1, llm
+c             write(77,*) pref(l),up(1,1,l)
+c          end do
+
+c Traitement des donnees -> creation de spectres synthetiques
+c -----------------------------------------------------------
+
+c calcul des vitesses projetees
+
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iip1
+
+
+               up(i,j,l)=(242.*cos(rlatu(j))+up(i,j,l))*
+     .              sin(rlonv(i)-lonst*pi/180)*cos(latst*pi/180)
+
+
+           vp(i,j,l)=vp(i,j,l)*(cos(rlonv(i)-lonst*pi/180)*sin(rlatu(j))
+     .    *cos(latst*pi/180)-sin(latst*pi/180)*cos(rlatu(j)))
+
+
+            enddo
+         enddo
+      enddo
+
+c synthese des spectres
+
+c	print*,'itau=',itau,nbpas
+
+      call spectre2(itau,iraie,latst,lonst,olon,olat,
+     .vp,up,tp,ps,tsurf)
+
+
+	
+c  Fin de la boucle sur les pas de temps ? : (we are in LOOP on timestep)
+c  ****************************************
+
+      itau=itau+1
+
+      if(itau.gt.nbpas) then
+         ierr = NF_CLOSE(nid)
+         write(*,*) 'Si vous voulez entrer un nouveau fichier'
+         print*,'entrez son nom. Sinon, RETURN'
+            READ(5,'(a)') nomfich
+         if (nomfich(1:lnblnk(nomfich)).eq."") then
+            print*,'OK, on termine la'
+         else
+            file=nomfich(1:lnblnk(nomfich))
+            PRINT*,'file',file
+            goto 800
+         endif
+      else
+         goto 801
+      endif
+
+ 900   continue
+
+
+9999  PRINT*,'Fin '
+1000  format(a5,3x,i4,i3,x,a39)
+7777  FORMAT ('latitude/longitude',4f7.1)
+
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/bernoui.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/bernoui.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/bernoui.F	(revision 46)
@@ -0,0 +1,56 @@
+      SUBROUTINE bernoui (ngrid,nlay,pphi,pecin,pbern)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:   P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c     calcul de la fonction de Bernouilli aux niveaux s  .....
+c     phi  et  ecin  sont des arguments d'entree pour le s-pg .......
+c          bern       est un  argument de sortie pour le s-pg  ......
+c
+c    fonction de Bernouilli = bern = filtre de( geopotentiel + 
+c                              energ.cinet.)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Decalrations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+c
+c   Arguments:
+c   ----------
+c
+      INTEGER nlay,ngrid
+      REAL pphi(ngrid*nlay),pecin(ngrid*nlay),pbern(ngrid*nlay)
+c
+c   Local:
+c   ------
+c
+      INTEGER   ijl
+      EXTERNAL  filtreg
+c
+c-----------------------------------------------------------------------
+c   calcul de Bernouilli:
+c   ---------------------
+c
+      DO 4 ijl = 1,ngrid*nlay
+         pbern( ijl ) =  pphi( ijl ) + pecin( ijl )
+   4  CONTINUE
+c
+c-----------------------------------------------------------------------
+c   filtre:
+c   -------
+c
+      CALL filtreg( pbern, jjp1, llm, 2,1, .true., 1 )
+c
+c-----------------------------------------------------------------------
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn.F	(revision 46)
@@ -0,0 +1,125 @@
+      SUBROUTINE caldyn
+     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Auteur :  P. Le Van
+c
+c   Objet:
+c   ------
+c
+c   Calcul des tendances dynamiques.
+c
+c Modif 04/93 F.Forget
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   0. Declarations:
+c   ----------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      LOGICAL conser
+
+      INTEGER itau
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL time
+
+c   Local:
+c   ------
+
+      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
+      REAL vorpot(ip1jm,llm)
+      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
+      REAL bern(ip1jmp1,llm)
+      REAL massebxy(ip1jm,llm)
+    
+
+      INTEGER   ij,l
+      EXTERNAL  advect,bernoui,convmas,covcont,dteta1,dudv1,dudv2,
+     *          enercin,flumass,tourpot,vitvert,sortvarc,
+     *          pression,psextbar,massdair
+
+c-----------------------------------------------------------------------
+c   Calcul des tendances dynamiques:
+c   --------------------------------
+
+      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
+      CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )
+      CALL psextbar (   ps   , psexbarxy                            )
+      CALL massdair (    p   , masse                                )
+      CALL massbar  (   masse, massebx , masseby                    )
+      call massbarxy(   masse, massebxy                             )
+      CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
+      CALL dteta1   (   teta , pbaru   , pbarv, dteta               )
+      CALL convmas  (   pbaru, pbarv   , convm                      )
+
+      DO ij =1, ip1jmp1
+         dp( ij ) = convm( ij,1 ) / airesurg( ij )
+      ENDDO
+c     write (38,*) "convm: ",convm
+c     write (38,*) "airesurg: ",airesurg
+c     write (38,*) "iip1: ",iip1
+c     close (38)
+
+
+      CALL vitvert ( convm  , w                                  )
+      CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )
+      CALL dudv1   ( vorpot , pbaru , pbarv     , du     , dv    )
+      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
+      CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )
+      CALL dudv2   ( teta   , pkf   , bern      , du     , dv    )
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            ang(ij,l) = ucov(ij,l) + constang(ij)
+      ENDDO
+      ENDDO
+
+
+      CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta ) 
+
+C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi 
+C          probablement. Observe sur le code compile avec pgf90 3.0-1 
+
+      DO l = 1, llm
+         DO ij = 1, ip1jm, iip1
+           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
+c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',  
+c    ,   ' dans caldyn'
+c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
+          dv(ij+iim,l) = dv(ij,l)
+          endif
+         enddo
+      enddo
+c-----------------------------------------------------------------------
+c   Sorties eventuelles des variables de controle:
+c   ----------------------------------------------
+!      write(*,*) 'CALDYN: itau=',itau,' conser=',conser
+      IF( conser )  THEN
+        CALL sortvarc
+     $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
+
+      ENDIF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/caldyn0.F	(revision 46)
@@ -0,0 +1,88 @@
+      SUBROUTINE caldyn0
+     $ (itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     $  phi,w,pbaru,pbarv,time )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Auteur :  P. Le Van
+c
+c   Objet:
+c   ------
+c
+c   Calcul des tendances dynamiques.
+c
+c Modif 04/93 F.Forget
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   0. Declarations:
+c   ----------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL pk(iip1,jjp1,llm)
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL time
+
+c   Local:
+c   ------
+
+      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
+      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
+      REAL vorpot(ip1jm,llm)
+      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
+      REAL bern(ip1jmp1,llm)
+      REAL massebxy(ip1jm,llm), dp(ip1jmp1)
+    
+
+      INTEGER   ij,l
+      EXTERNAL  advect,bernoui,convmas,covcont ,
+     *          enercin,flumass,tourpot,vitvert,sortvarc,traceur,
+     *          pression,psextbar,massdair
+
+c-----------------------------------------------------------------------
+c   Calcul des tendances dynamiques:
+c   --------------------------------
+      CALL covcont  (llm,ucov,vcov,ucont,vcont)
+      CALL pression (ip1jmp1,ap,bp,ps,p)
+      CALL psextbar (ps,psexbarxy)
+      CALL massdair (p,masse)
+      CALL massbar  (masse,massebx,masseby)
+      CALL massbarxy(masse,massebxy)
+      CALL flumass  (massebx,masseby,vcont,ucont,pbaru,pbarv)
+      CALL convmas  (pbaru,pbarv,convm)
+
+      DO ij =1, ip1jmp1
+         dp( ij ) = convm( ij,1 ) / airesurg( ij )
+      ENDDO
+
+      CALL vitvert (convm,w)
+      CALL tourpot (vcov,ucov,massebxy,vorpot)
+      CALL enercin (vcov,ucov,vcont,ucont,ecin)
+      CALL bernoui (ip1jmp1,llm,phi,ecin,bern)
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            ang(ij,l) = ucov(ij,l) + constang(ij)
+         ENDDO
+      ENDDO
+
+        CALL sortvarc0
+     $ (itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/calfis.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/calfis.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/calfis.F	(revision 46)
@@ -0,0 +1,548 @@
+      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
+     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
+     $            pducov,pdvcov,pdteta,pdq,pw,
+     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       pw              flux vertical (kg m-2)
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature
+c        pdtsfi         tendency for the surface temperature
+c
+c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+
+      INTEGER ngridmx,nq
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+
+c    Arguments :
+c    -----------
+      LOGICAL  lafin
+      REAL heure
+
+      REAL pvcov(iip1,jjm,llm)
+      REAL pucov(iip1,jjp1,llm)
+      REAL pteta(iip1,jjp1,llm)
+      REAL pmasse(iip1,jjp1,llm)
+      REAL pq(iip1,jjp1,llm,nqmx)
+      REAL pphis(iip1,jjp1)
+      REAL pphi(iip1,jjp1,llm)
+c
+      REAL pdvcov(iip1,jjm,llm)
+      REAL pducov(iip1,jjp1,llm)
+      REAL pdteta(iip1,jjp1,llm)
+      REAL pdq(iip1,jjp1,llm,nqmx)
+c
+      REAL pw(iip1,jjp1,llm)
+c
+      REAL pps(iip1,jjp1)
+      REAL pp(iip1,jjp1,llmp1)
+      REAL ppk(iip1,jjp1,llm)
+c
+      REAL pdvfi(iip1,jjm,llm)
+      REAL pdufi(iip1,jjp1,llm)
+      REAL pdhfi(iip1,jjp1,llm)
+      REAL pdqfi(iip1,jjp1,llm,nqmx)
+      REAL pdpsfi(iip1,jjp1)
+      logical tracer
+
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+c
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqmx)
+c
+      REAL zvervel(ngridmx,llm)
+c
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqmx)
+      REAL zdpsrf(ngridmx)
+c
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+c
+      
+      EXTERNAL gr_dyn_fi,gr_fi_dyn
+      EXTERNAL physiq,multipl
+      REAL SSUM
+      EXTERNAL SSUM
+
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+
+      LOGICAL firstcal, debut
+      DATA firstcal/.true./
+      SAVE firstcal,debut
+      REAL rdayvrai,rday_ecri
+c
+c-----------------------------------------------------------------------
+c
+c    1. Initialisations :
+c    --------------------
+c
+
+
+      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         PRINT*,'STOP dans calfis'
+         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         PRINT*,'  ngridmx  jjm   iim   '
+         PRINT*,ngridmx,jjm,iim
+         STOP
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   latitude, longitude et aires des mailles pour la physique:
+c   ----------------------------------------------------------
+
+c
+      IF ( firstcal )  THEN
+          debut = .TRUE.
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+c
+      IF (firstcal) THEN
+         latfi(1)=rlatu(1)
+         lonfi(1)=0.
+         DO j=2,jjm
+            DO i=1,iim
+               latfi((j-2)*iim+1+i)= rlatu(j)
+               lonfi((j-2)*iim+1+i)= rlonv(i)
+            ENDDO
+         ENDDO
+         latfi(ngridmx)= rlatu(jjp1)
+         lonfi(ngridmx)= 0.
+         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+
+         CALL inifis(ngridmx,llm,day_ini,daysec,dtphys,
+     .                latfi,lonfi,airefi,rad,g,r,cpp)
+      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+
+c   42. pression intercouches :
+c
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+c
+       unskap   = 1./ kappa
+c
+      DO l = 1, llmp1
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+c
+c
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
+         ig0         =  2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
+
+      ENDDO
+
+      DO l=1, llm
+        DO ig=1,ngridmx
+             if (ztfi(ig,l).lt.15) then
+                  write(*,*) 'New Temperature below 15 K !!! '
+	              write(*,*) 'Stop in calfis.F '
+	              write(*,*) 'ig=', ig, ' l=', l
+                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
+                  stop
+             end if
+        ENDDO
+      ENDDO
+
+
+
+c   43.bis Taceurs (en kg/kg)
+c   --------------------------
+      DO iq=1,nqmx
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+            zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
+c   -------------------------------
+c     pw est en kg/s
+c On interpole "lineairement" la temperature entre les couches(FF,10/95)
+
+      DO ig=1,ngridmx
+         zvervel(ig,1)=0.
+      END DO
+      DO l=2,llm
+        zvervel(1,l)=(pw(1,1,l)/apoln)
+     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
+        ig0=2
+       DO j=2,jjm
+           DO i = 1, iim
+              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+              ig0 = ig0 + 1
+           ENDDO
+       ENDDO
+        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
+     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+      ENDDO
+
+c    .........  Reindexation : calcul de zvervel au MILIEU des couches
+       DO l=1,llm-1
+	      DO ig=1,ngridmx
+		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
+          END DO 
+       END DO 
+c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
+
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+      ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+      ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+
+      CALL physiq (ngridmx,llm,nq,
+     ,     debut,lafin,
+     ,     rday_ecri,heure,dtphys,
+     ,     zplev,zplay,zphi,
+     ,     zufi, zvfi,ztfi, zqfi,  
+     ,     zvervel,
+C - sorties
+     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
+
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
+
+c   62. enthalpie potentielle
+c   ---------------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
+            ENDDO
+               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   62. humidite specifique
+c   ---------------------
+
+      DO iq=1,nqmx
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+      ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+
+      firstcal = .FALSE.
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coefpoly.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coefpoly.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coefpoly.F	(revision 46)
@@ -0,0 +1,38 @@
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/coefpoly.F,v 1.1 2001/04/23 08:43:28 lmdz Exp $
+      SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
+     ,                                          a0,a1,a2,a3         )
+      IMPLICIT NONE
+c
+c   ...  Auteur :   P. Le Van  ...
+c
+c
+c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
+c      satisfait aux 4 equations  suivantes :
+
+c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
+c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
+c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
+c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
+
+c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
+
+      REAL*8 Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi 
+      REAL*8 Xfout, Xprim
+      REAL*8 a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
+
+      xtil1car = xtild1 * xtild1
+      xtil2car = xtild2 * xtild2 
+
+      derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
+
+      x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
+
+      a3 = (derr + Xprim1+Xprim2 )/x1x2car
+      a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
+     /           (  2.* ( xtild1 - xtild2 )  )
+
+      a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
+      a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convflu.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convflu.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convflu.F	(revision 46)
@@ -0,0 +1,60 @@
+      SUBROUTINE convflu( xflu,yflu,nbniv,convfl )
+c
+c  P. Le Van
+c
+c
+c    *******************************************************************
+c  ... calcule la (convergence horiz. * aire locale)du flux ayant pour
+c      composantes xflu et yflu ,variables extensives .  ......
+c    *******************************************************************
+c      xflu , yflu et nbniv sont des arguments d'entree pour le s-pg ..
+c      convfl                est  un argument de sortie pour le s-pg .
+c
+c     njxflu  est le nombre de lignes de latitude de xflu, 
+c     ( = jjm ou jjp1 )
+c     nbniv   est le nombre de niveaux vert. de  xflu et de yflu .
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+      REAL       xflu,yflu,convfl,convpn,convps
+      INTEGER    l,ij,nbniv
+      DIMENSION  xflu( ip1jmp1,nbniv ),yflu( ip1jm,nbniv ) ,
+     *         convfl( ip1jmp1,nbniv )
+c
+      EXTERNAL   SSUM
+      REAL       SSUM
+c
+c
+#include "comgeom.h"
+c
+      DO 5 l = 1,nbniv
+c
+      DO 2  ij = iip2, ip1jm - 1
+      convfl( ij + 1,l ) =  xflu(   ij,l ) - xflu( ij +  1,l )   +
+     *                      yflu(ij +1,l ) - yflu( ij -iim,l )
+   2  CONTINUE
+c
+c
+
+c     ....  correction pour  convfl( 1,j,l)  ......
+c     ....   convfl(1,j,l)= convfl(iip1,j,l) ...
+c
+CDIR$ IVDEP
+      DO 3 ij = iip2,ip1jm,iip1
+      convfl( ij,l ) = convfl( ij + iim,l )
+   3  CONTINUE
+c
+c     ......  calcul aux poles  .......
+c
+      convpn =   SSUM( iim, yflu(     1    ,l ),  1 )
+      convps = - SSUM( iim, yflu( ip1jm-iim,l ),  1 )
+      DO 4 ij = 1,iip1
+      convfl(     ij   ,l ) = convpn * aire(   ij     ) / apoln
+      convfl( ij+ ip1jm,l ) = convps * aire( ij+ ip1jm) / apols
+   4  CONTINUE
+c
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convmas.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convmas.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/convmas.F	(revision 46)
@@ -0,0 +1,62 @@
+      SUBROUTINE convmas (pbaru, pbarv, convm )
+c
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , F. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   ********************************************************************
+c   .... calcul de la convergence du flux de masse aux niveaux p ...
+c   ********************************************************************
+c
+c
+c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
+c      .....  convm      est  un argument de sortie pour le s-pg  ....
+c
+c    le calcul se fait de haut en bas, 
+c    la convergence de masse au niveau p(llm+1) est egale a 0. et
+c    n'est pas stockee dans le tableau convm .
+c
+c
+c=======================================================================
+c
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "logic.h"
+
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm ),convm(  ip1jmp1,llm )
+      INTEGER   l,ij
+
+      EXTERNAL   filtreg
+      EXTERNAL   convflu
+
+c-----------------------------------------------------------------------
+c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
+
+      CALL convflu( pbaru, pbarv, llm, convm )
+
+c-----------------------------------------------------------------------
+c   filtrage:
+c   ---------
+
+       CALL filtreg( convm, jjp1, llm, 2, 2, .true., 1 )
+
+c    integration de la convergence de masse de haut  en bas ......
+
+      DO      l      = llmm1, 1, -1
+        DO    ij     = 1, ip1jmp1
+         convm(ij,l) = convm(ij,l) + convm(ij,l+1)
+        ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coordij.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coordij.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/coordij.F	(revision 46)
@@ -0,0 +1,48 @@
+      SUBROUTINE coordij(lon,lat,ilon,jlat)
+
+c=======================================================================
+c
+c   calcul des coordonnees i et j de la maille scalaire dans
+c   laquelle se trouve le point (lon,lat) en radian
+c
+c=======================================================================
+
+      IMPLICIT NONE
+      REAL lon,lat
+      INTEGER ilon,jlat
+      INTEGER i,j
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "serre.h"
+
+      real zlon,zlat
+
+      zlon=lon
+      zlat=lat
+
+      DO i=1,iim+1
+        print*,i,' ',rlonu(i),' ',zlon 
+         IF (rlonu(i).GT.zlon) THEN
+            ilon=i
+            GOTO 10
+         ENDIF
+      ENDDO
+10    CONTINUE
+
+      j=0
+      DO j=1,jjm
+        print*,j,' ',rlatv(j),' ' ,zlat 
+         IF(rlatv(j).LT.zlat) THEN
+           
+            jlat=j
+            GOTO 20
+         ENDIF
+      ENDDO
+20    CONTINUE
+      IF(j.EQ.0) j=jjm+1
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covcont.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covcont.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covcont.F	(revision 46)
@@ -0,0 +1,41 @@
+      SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c  *********************************************************************
+c    calcul des compos. contravariantes a partir des comp.covariantes
+c  ********************************************************************
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL ucov ( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
+      REAL ucont( ip1jmp1,klevel ), vcont( ip1jm,klevel )
+      INTEGER   l,ij
+
+
+      DO 10 l = 1,klevel
+
+      DO 2  ij = iip2, ip1jm
+      ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )
+   2  CONTINUE
+
+      DO 4 ij = 1,ip1jm
+      vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )
+   4  CONTINUE
+
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covnat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covnat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/covnat.F	(revision 46)
@@ -0,0 +1,46 @@
+      SUBROUTINE covnat (klevel,ucov, vcov, unat, vnat )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  F Hourdin Phu LeVan
+c   -------
+c
+c   Objet:
+c   ------
+c
+c  *********************************************************************
+c    calcul des compos. naturelles a partir des comp.covariantes
+c  ********************************************************************
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL ucov( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
+      REAL unat( ip1jmp1,klevel ), vnat( ip1jm,klevel )
+      INTEGER   l,ij
+
+
+      DO l = 1,klevel
+         DO ij = 1, iip1
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = iip2, ip1jm
+            unat( ij,l ) = ucov( ij,l ) / cu(ij)
+         ENDDO
+         DO ij = ip1jm+1, ip1jmp1  
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = 1,ip1jm
+            vnat( ij,l ) = vcov( ij,l ) / cv(ij)
+         ENDDO
+
+      ENDDO
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/defrun_new.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/defrun_new.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/defrun_new.F	(revision 46)
@@ -0,0 +1,510 @@
+      SUBROUTINE defrun_new( tapedef, etatinit )
+c
+c-----------------------------------------------------------------------
+c     Auteurs :   L. Fairhead , P. Le Van  .
+c      Modif C. Hourdin F. Forget VERSION MARTIENNE
+c
+c
+c  -------------------------------------------------------------------
+c
+c                    MODIF JUIN 2000 (zoom)
+c       .........     Version  du 29/04/97       ..........
+c
+c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
+c   tetatemp   ajoutes  pour la dissipation   .
+c
+c   Autre parametre ajoute en fin de liste : ** fxyhypb ** 
+c
+c   Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
+c   Sinon , choix de fxynew  , a derivee sinusoidale  ..
+c
+c   ......  etatinit = . TRUE. si defrun_new  est appele dans NEWSTART
+c   ETAT0_LMD  ou  LIMIT_LMD  pour l'initialisation de start.dat (dic) et
+c   de limit.dat (dic)  ...........
+c   Sinon  etatinit = . FALSE .
+c
+c   Donc etatinit = .F.  si on veut comparer les valeurs de  alphax ,
+c   alphay,clon,clat, fxyhypb  lues sur  le fichier  start  avec
+c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
+c   lectba .  
+c   Ces parametres definissant entre autres la grille et doivent etre
+c   pareils et coherents , sinon il y aura  divergence du gcm .
+c
+c
+c-----------------------------------------------------------------------
+c   Declarations :
+c   --------------
+! to use  'getin'
+      USE ioipsl_getincom
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "control.h"
+#include "logic.h"
+#include "serre.h"
+#include "comdissnew.h"
+#include "sponge.h"
+c
+c   arguments:
+c   ---------
+      LOGICAL  etatinit ! should be .false. for a call from gcm.F
+                        ! and .true. for a call from newstart.F
+      INTEGER  tapedef  ! unit number to assign to 'run.def' file
+c
+c   local variables:
+c   ---------------
+
+      CHARACTER ch1*72,ch2*72,ch3*72,ch4*8 ! to store various strings
+      INTEGER tapeout ! unit numbers for (standard) outputs
+      parameter (tapeout=6)
+      integer tapeerr ! unit number for error message
+      parameter (tapeerr=0)
+
+c     REAL clonn,clatt,alphaxx,alphayy
+c     LOGICAL  fxyhypbb
+      INTEGER ierr
+      REAL clonn,clatt,grossismxx,grossismyy
+      REAL dzoomxx,dzoomyy,tauxx,tauyy,temp
+      LOGICAL  fxyhypbb, ysinuss
+
+
+c   initialisations:
+c   ----------------
+ 
+!      tapeout=6
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+
+!Initialisation des parametres "terrestres", qui ne concernent pas
+!le modele martien et ne sont donc plus lues dans "run.def"
+
+        anneeref=0
+        ! Note: anneref is a common in 'control.h'
+
+      OPEN(tapedef,file='run.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      CLOSE(tapedef) ! first call to getin will open the file
+
+      IF(ierr.EQ.0) THEN ! if file run.def is found
+        WRITE(tapeout,*) "DEFRUN_NEW: reading file run.def"
+        
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Number of days to run:"
+        nday=1 ! default value
+        call getin("nday",nday)
+        WRITE(tapeout,*)" nday = ",nday
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Number of dynamical steps per day:",
+     & "(should be a multiple of iperiod)"
+        day_step=960 ! default value
+        call getin("day_step",day_step)
+        WRITE(tapeout,*)" day_step = ",day_step
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "periode pour le pas Matsuno (en pas)"
+        iperiod=5 ! default value
+        call getin("iperiod",iperiod)
+        WRITE(tapeout,*)" iperiod = ",iperiod
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "periode de sortie des variables de ",
+     &  "controle (en pas)"
+        iconser=120 ! default value
+        call getin("iconser",iconser)
+        WRITE(tapeout,*)" iconser = ",iconser
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "periode de la dissipation (en pas)"
+        idissip=5 ! default value
+        call getin("idissip",idissip)
+        WRITE(tapeout,*)" idissip = ",idissip
+
+ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+ccc
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "choix de l'operateur de dissipation ",
+     & "(star ou  non star )"
+        lstardis=.true. ! default value
+        call getin("lstardis",lstardis)
+        WRITE(tapeout,*)" lstardis = ",lstardis
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "avec ou sans coordonnee hybrides"
+        hybrid=.true. ! default value
+        call getin("hybrid",hybrid)
+        WRITE(tapeout,*)" hybrid = ",hybrid
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "nombre d'iterations de l'operateur de ",
+     & "dissipation   gradiv "
+        nitergdiv=1 ! default value
+        call getin("nitergdiv",nitergdiv)
+        WRITE(tapeout,*)" nitergdiv = ",nitergdiv
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "nombre d'iterations de l'operateur de ",
+     & "dissipation  nxgradrot"
+        nitergrot=2 ! default value
+        call getin("nitergrot",nitergrot)
+        WRITE(tapeout,*)" nitergrot = ",nitergrot
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "nombre d'iterations de l'operateur de ",
+     & "dissipation  divgrad"
+        niterh=2 ! default value
+        call getin("niterh",niterh)
+        WRITE(tapeout,*)" niterh = ",niterh
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "temps de dissipation des plus petites ",
+     & "long.d ondes pour u,v (gradiv)"
+        tetagdiv=4000. ! default value
+        call getin("tetagdiv",tetagdiv)
+        WRITE(tapeout,*)" tetagdiv = ",tetagdiv
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "temps de dissipation des plus petites ",
+     & "long.d ondes pour u,v(nxgradrot)"
+        tetagrot=5000. ! default value
+        call getin("tetagrot",tetagrot)
+        WRITE(tapeout,*)" tetagrot = ",tetagrot
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "temps de dissipation des plus petites ",
+     & "long.d ondes pour  h ( divgrad)"
+        tetatemp=5000. ! default value
+        call getin("tetatemp",tetatemp)
+        WRITE(tapeout,*)" tetatemp = ",tetatemp
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "coefficient pour gamdissip"
+        coefdis=0. ! default value
+        call getin("coefdis",coefdis)
+        WRITE(tapeout,*)" coefdis = ",coefdis
+c
+c    ...............................................................
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "choix du shema d'integration temporelle ",
+     & "(true==Matsuno ou false==Matsuno-leapfrog)"
+        purmats=.false. ! default value
+        call getin("purmats",purmats)
+        WRITE(tapeout,*)" purmats = ",purmats
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "avec ou sans physique"
+        physic=.true. ! default value
+        call getin("physic",physic)
+        WRITE(tapeout,*)" physic = ",physic
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "periode de la physique (en pas)"
+        iphysiq=20 ! default value
+        call getin("iphysiq",iphysiq)
+        WRITE(tapeout,*)" iphysiq = ",iphysiq
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "choix d'une grille reguliere"
+        grireg=.true.
+        call getin("grireg",grireg)
+        WRITE(tapeout,*)" grireg = ",grireg
+
+ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
+c
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "frequence (en pas) de l'ecriture ",
+     & "du fichier diagfi.nc"
+        ecritphy=240
+        call getin("ecritphy",ecritphy)
+        WRITE(tapeout,*)" ecritphy = ",ecritphy
+
+ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
+c     .........   (  modif  le 17/04/96 )   .........
+c
+        if (.not.etatinit ) then 
+
+           clonn=63.
+           call getin("clon",clonn)
+           
+           IF( ABS(clon - clonn).GE. 0.001 )  THEN
+             PRINT *,' La valeur de clon passee par run.def est '
+     *       ,'differente de celle lue sur le fichier start '
+             STOP
+           ENDIF
+c
+c
+           clatt=0.
+           call getin("clat",clatt)
+  
+           IF( ABS(clat - clatt).GE. 0.001 )  THEN
+             PRINT *,' La valeur de clat passee par run.def est '
+     *       ,'differente de celle lue sur le fichier start '
+             STOP
+           ENDIF
+
+           grossismxx=1.0
+           call getin("grossismx",grossismxx)
+
+           if(grossismxx.eq.0) then  
+             write(*,*)
+             write(*,*)'ERREUR : dans run.def, grossismx =0'
+             write(*,*)'Attention a ne pas utiliser une version de'
+             write(*,*)'run.def avant le nouveau zoom LMDZ2.3 (06/2000)'
+             write(*,*)'(Il faut ajouter grossismx,dzoomx,etc... a la'
+             write(*,*)'place de alphax, alphay. cf. dyn3d). '
+             write(*,*)
+             stop
+           end if
+
+           IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
+             PRINT *,' La valeur de grossismx passee par run.def est '
+     *       ,'differente de celle lue sur le fichier  start =',
+     *        grossismx
+             if (grossismx.eq.0) then
+                  write(*,*) 'OK,Normal : c est un vieux start'
+     *             , 'd avant le nouveau zoom LMDZ2.3 (06/2000)'
+                 grossismx=grossismxx
+             else
+                   STOP
+             endif
+           ENDIF
+
+           grossismyy=1.0
+           call getin("grossismy",grossismyy)
+
+           IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
+             PRINT *,' La valeur de grossismy passee par run.def est '
+     *       ,'differente de celle lue sur le fichier  start =',
+     *        grossismy
+             if (grossismy.eq.0) then
+                  write(*,*) 'OK,Normal : c est un vieux start'
+     *             , 'd avant le nouveau zoom LMDZ2.3 (06/2000)'
+                 grossismy=grossismyy
+             else
+                   STOP
+             endif
+           ENDIF
+
+
+           IF( grossismx.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+             STOP
+           ELSE
+             alphax = 1. - 1./ grossismx
+           ENDIF
+
+           IF( grossismy.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+             STOP
+           ELSE
+             alphay = 1. - 1./ grossismy
+           ENDIF
+
+           PRINT *,' '
+           PRINT *,' --> In defrun: alphax alphay  ',alphax,alphay
+           PRINT *,' '
+c
+           fxyhypbb=.false.
+           call getin("fxyhypbb",fxyhypbb)
+  
+           IF( .NOT.fxyhypb )  THEN
+             IF( fxyhypbb )     THEN
+                PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+                PRINT *,' *** fxyhypb lu sur le fichier start est F ',
+     *          'alors  qu il est  T  sur  run.def  ***'
+                STOP
+             ENDIF
+           ELSE
+             IF( .NOT.fxyhypbb )   THEN
+                PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+                PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
+     *         'alors  qu il est  F  sur  run.def  ****  '
+                STOP
+             ENDIF
+           ENDIF
+           dzoomxx=0.0
+           call getin("dzoomx",dzoomxx)
+
+           IF( fxyhypb )  THEN
+              IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+                PRINT *,' La valeur de dzoomx passee par run.def est '
+     *          ,'differente de celle lue sur le fichier  start '
+                STOP
+              ENDIF
+           ENDIF
+
+           dzoomyy=0.0
+           call getin("dzoomy",dzoomyy)
+
+           IF( fxyhypb )  THEN
+              IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
+                PRINT *,' La valeur de dzoomy passee par run.def est '
+     *          ,'differente de celle lue sur le fichier  start '
+                STOP
+              ENDIF
+           ENDIF
+
+           tauxx=2.0
+           call getin("taux",tauxx)
+
+           tauyy=2.0
+           call getin("tauy",tauyy)
+
+           IF( fxyhypb )  THEN
+              IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+                WRITE(6,*)' La valeur de taux passee par run.def est', 
+     *             'differente de celle lue sur le fichier  start '
+                CALL ABORT
+              ENDIF
+
+              IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+                WRITE(6,*)' La valeur de tauy passee par run.def est',
+     *          'differente de celle lue sur le fichier  start '
+                CALL ABORT
+              ENDIF
+           ENDIF
+  
+        ELSE    ! Below, case when etainit=.true.
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "longitude en degres du centre du zoom"
+           clon=63. ! default value
+           call getin("clon",clon)
+           WRITE(tapeout,*)" clon = ",clon
+           
+c
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "latitude en degres du centre du zoom "
+           clat=0. ! default value
+           call getin("clat",clat)
+           WRITE(tapeout,*)" clat = ",clat
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "facteur de grossissement du zoom,",
+     & " selon longitude"
+           grossismx=1.0 ! default value
+           call getin("grossismx",grossismx)
+           WRITE(tapeout,*)" grossismx = ",grossismx
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "facteur de grossissement du zoom ,",
+     & " selon latitude"
+           grossismy=1.0 ! default value
+           call getin("grossismy",grossismy)
+           WRITE(tapeout,*)" grossismy = ",grossismy
+
+           IF( grossismx.LT.1. )  THEN
+            PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+            STOP
+           ELSE
+             alphax = 1. - 1./ grossismx
+           ENDIF
+
+           IF( grossismy.LT.1. )  THEN
+             PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+             STOP
+           ELSE
+             alphay = 1. - 1./ grossismy
+           ENDIF
+
+           PRINT *,' Defrun  alphax alphay  ',alphax,alphay
+c
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "Fonction  f(y)  hyperbolique  si = .true.",
+     &  ", sinon  sinusoidale"
+           fxyhypb=.false. ! default value
+           call getin("fxyhypb",fxyhypb)
+           WRITE(tapeout,*)" fxyhypb = ",fxyhypb
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "extension en longitude de la zone du zoom", 
+     & " (fraction de la zone totale)"
+           dzoomx=0. ! default value
+           call getin("dzoomx",dzoomx)
+           WRITE(tapeout,*)" dzoomx = ",dzoomx
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "extension en latitude de la zone du zoom", 
+     & " (fraction de la zone totale)"
+           dzoomy=0. ! default value
+           call getin("dzoomy",dzoomy)
+           WRITE(tapeout,*)" dzoomy = ",dzoomy
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "raideur du zoom en  X"
+           taux=2. ! default value
+           call getin("taux",taux)
+           WRITE(tapeout,*)" taux = ",taux
+
+           WRITE(tapeout,*) ""
+           WRITE(tapeout,*) "raideur du zoom en  Y"
+           tauy=2.0 ! default value
+           call getin("tauy",tauy)
+           WRITE(tapeout,*)" tauy = ",tauy
+
+        END IF ! of if (.not.etatinit )
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Avec sponge layer"
+        callsponge=.true. ! default value
+        call getin("callsponge",callsponge)
+        WRITE(tapeout,*)" callsponge = ",callsponge
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Sponge:  mode0(u=v=0), mode1(u=umoy,v=0), ",
+     & "mode2(u=umoy,v=vmoy)"
+        mode_sponge=2 ! default value
+        call getin("mode_sponge",mode_sponge)
+        WRITE(tapeout,*)" mode_sponge = ",mode_sponge
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Sponge:  hauteur de sponge (km)"
+        hsponge=90.0 ! default value
+        call getin("hsponge",hsponge)
+        WRITE(tapeout,*)" hsponge = ",hsponge
+
+        WRITE(tapeout,*) ""
+        WRITE(tapeout,*) "Sponge:  tetasponge (secondes)"
+        tetasponge=50000.0
+        call getin("tetasponge",tetasponge)
+        WRITE(tapeout,*)" tetasponge = ",tetasponge
+
+
+      WRITE(tapeout,*) '-----------------------------------------------'
+      WRITE(tapeout,*) ' '
+      WRITE(tapeout,*) ' '
+c
+
+c       Unlike on Earth (cf LMDZ2.2) , always a regular grid on Mars :
+        ysinus = .false. !Mars Mettre a jour
+
+
+      WRITE(tapeout,*) '-----------------------------------------------'
+      WRITE(tapeout,*) ' '
+      WRITE(tapeout,*) ' '
+cc
+      ELSE
+        write(tapeerr,*) ' WHERE IS run.def ? WE NEED IT !!!!!!!!!!!!!!'
+        stop
+      ENDIF ! of IF(ierr.eq.0)
+
+c     Test sur le zoom
+
+      if((grossismx.eq.1).and.(grossismy.eq.1)) then  
+c        Pas de zoom :
+         write(tapeout,*) 'No zoom ? -> fxyhypb set to False'
+     &   ,'           (It runs better that way)'
+         fxyhypb = .false.
+      else     
+c        Avec Zoom
+         if (.not.fxyhypb) stop 'With zoom, fxyhypb should be set to T 
+     &in run.def for this version... -> STOP ! '     
+      end if
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diagadv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diagadv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diagadv.F	(revision 46)
@@ -0,0 +1,77 @@
+      subroutine diagadv(q,masse,descript)
+      implicit none
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      real q(iip1,jjp1,llm),masse(iip1,jjp1,llm)
+      integer i,j,l
+      character*10 descript
+      real sss,smas,smin,smax
+ 
+      external ismin,ismax
+      integer ismin,ismax
+ 
+      sss=0.
+      smas=0.
+      smin=1.e33
+      smax=-1.e33
+      do l=1,llm
+        do j=1,jjp1
+           do i=1,iim
+              sss=sss+masse(i,j,l)*q(i,j,l)
+              smas=smas+masse(i,j,l)
+              smin=min(smin,q(i,j,l))
+              smax=max(smax,q(i,j,l))
+           enddo
+        enddo
+      enddo
+
+      write(*,1000) descript,smin,smax,sss/smas,sss
+ 
+      return
+1000  format(a10,'   MIN:',e15.4,'   MAX:',e15.4,'   MOY:',e15.4
+     s   ,'   TOT:',e15.4)
+      end
+
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
+C
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+       ix=ix+incx
+       if(sx(ix).gt.sxmax) then
+         sxmax=sx(ix)
+         ismax=i+1
+       endif
+10    continue
+c
+      return
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dissip.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dissip.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dissip.F	(revision 46)
@@ -0,0 +1,142 @@
+      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
+c
+      IMPLICIT NONE
+
+
+c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
+c                                 (  10/01/98  )
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   Dissipation horizontale
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comdissnew.h"
+#include "comdissipn.h"
+
+c   Arguments:
+c   ----------
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL  p( ip1jmp1,llmp1 )
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
+      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
+      REAL te1dt(llm),te2dt(llm),te3dt(llm)
+      REAL deltapres(ip1jmp1,llm)
+
+      INTEGER l,ij
+
+      REAL  SSUM
+      EXTERNAL  gradiv ,nXgrarot,divgrad,initial0
+      EXTERNAL  gradiv2,nXgraro2,divgrad2,SSUM
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      DO l=1,llm
+         te1dt(l) = tetaudiv(l) * dtdiss
+         te2dt(l) = tetaurot(l) * dtdiss
+         te3dt(l) = tetah(l)    * dtdiss
+      ENDDO
+      CALL initial0( ijp1llm, du )
+      CALL initial0( ijmllm , dv )
+      CALL initial0( ijp1llm, dh )
+
+c-----------------------------------------------------------------------
+c   Calcul de la dissipation:
+c   -------------------------
+
+c   Calcul de la partie   grad  ( div ) :
+c   -------------------------------------
+
+
+      IF(lstardis) THEN
+         CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
+      ELSE
+         CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
+      ENDIF
+
+      DO l=1,llm
+
+         DO ij = 1, iip1
+            gdx(     ij ,l) = 0.
+            gdx(ij+ip1jm,l) = 0.
+         ENDDO
+
+         DO ij = iip2,ip1jm
+            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
+         ENDDO
+
+       ENDDO
+
+c   calcul de la partie   n X grad ( rot ):
+c   ---------------------------------------
+
+      IF(lstardis) THEN
+         CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
+      ELSE
+         CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
+      ENDIF
+
+
+      DO l=1,llm
+         DO ij = 1, iip1
+            grx(ij,l) = 0.
+         ENDDO
+
+         DO ij = iip2,ip1jm
+            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
+         ENDDO
+         DO ij =  1, ip1jm
+            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
+         ENDDO
+      ENDDO
+
+c   calcul de la partie   div ( grad ):
+c   -----------------------------------
+
+        
+      IF(lstardis) THEN
+
+       DO l = 1, llm
+          DO ij = 1, ip1jmp1
+            deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
+          ENDDO
+       ENDDO
+
+         CALL divgrad2( llm,teta, deltapres  ,niterh, gdx )
+      ELSE
+         CALL divgrad ( llm,teta, niterh, gdx        )
+      ENDIF
+
+      DO l = 1,llm
+         DO ij = 1,ip1jmp1
+            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/disvert.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/disvert.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/disvert.F	(revision 46)
@@ -0,0 +1,300 @@
+      SUBROUTINE disvert 
+
+c    Auteur :  F. Forget Y. Wanherdrick, P. Levan
+c    Nouvelle version 100% Mars !!
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "logic.h"
+c
+c=======================================================================
+c    Discretisation verticale en coordonnée hybride OU sigma
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+c
+      INTEGER l,ll
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h,quoi,quand
+      REAL zsig(llm)
+      INTEGER np,ierr
+      integer :: ierr1,ierr2,ierr3,ierr4
+      REAL x
+
+      REAL SSUM
+      EXTERNAL SSUM
+      real newsig 
+      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
+      real tt,rr,gg, prevz
+      real s(llm),dsig(llm) 
+
+      integer iz 
+      real z, ps,p
+
+c
+c-----------------------------------------------------------------------
+c
+      pi=2.*ASIN(1.)
+
+! Ouverture possible de fichiers typiquement E.T.
+
+         open(99,file="esasig.def",status='old',form='formatted',
+     s   iostat=ierr2)
+         if(ierr2.ne.0) then
+              close(99)
+              open(99,file="z2sig.def",status='old',form='formatted',
+     s        iostat=ierr4)
+         endif
+
+c-----------------------------------------------------------------------
+c   cas 1 on lit les options dans esasig.def:
+c   ----------------------------------------
+
+      IF(ierr2.eq.0) then
+
+c        Lecture de esasig.def :
+c        Systeme peu souple, mais qui respecte en theorie
+c        La conservation de l'energie (conversion Energie potentielle
+c        <-> energie cinetique, d'apres la note de Frederic Hourdin...
+
+         PRINT*,'*****************************'
+         PRINT*,'WARNING Lecture de esasig.def'
+         PRINT*,'*****************************'
+         READ(99,*) h
+         READ(99,*) dz0
+         READ(99,*) dz1
+         READ(99,*) nhaut
+         CLOSE(99)
+
+         dz0=dz0/h
+         dz1=dz1/h
+
+         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
+
+         esig=1.
+
+         do l=1,20
+            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
+         enddo
+         csig=(1./sig1-1.)/(exp(esig)-1.)
+
+         DO L = 2, llm
+            zz=csig*(exp(esig*(l-1.))-1.)
+            sig(l) =1./(1.+zz)
+     &      * tanh(.5*(llm+1-l)/nhaut)
+         ENDDO
+         sig(1)=1.
+         sig(llm+1)=0.
+         quoi      = 1. + 2.* kappa
+         s( llm )  = 1.
+         s(llm-1) = quoi
+         IF( llm.gt.2 )  THEN
+            DO  ll = 2, llm-1
+               l         = llm+1 - ll
+               quand     = sig(l+1)/ sig(l)
+               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
+            ENDDO
+         END IF
+c
+         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
+         DO l = 1, llm
+            s(l)    = s(l)/ snorm
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   cas 2 on lit les options dans z2sig.def:
+c   ----------------------------------------
+
+      ELSE IF(ierr4.eq.0) then
+         PRINT*,'****************************'
+         PRINT*,'Lecture de z2sig.def'
+         PRINT*,'****************************'
+
+         READ(99,*) h
+         do l=1,llm
+            read(99,*) zsig(l)
+         end do
+         CLOSE(99)
+
+         sig(1) =1
+         do l=2,llm
+           sig(l) = 0.5 * ( exp(-zsig(l)/h) + exp(-zsig(l-1)/h) )
+         end do
+         sig(llm+1) =0
+
+c-----------------------------------------------------------------------
+      ELSE
+         write(*,*) 'didn t you forget something ??? '
+         write(*,*) 'We need the file  z2sig.def ! (OR esasig.def) '
+         stop
+      ENDIF
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+
+ 
+c-----------------------------------------------------------------------
+c    ....  Calculs  de ap(l) et de bp(l)  ....
+c    .........................................
+c
+c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
+c-----------------------------------------------------------------------
+c
+
+      if (hybrid) then
+         write(*,*) "*******************************"
+         write(*,*) "Systeme en coordonnees hybrides"
+         write(*,*) 
+c        Coordonnees hybrides avec mod
+         DO l = 1, llm
+
+         call sig_hybrid(sig(l),pa,preff,newsig)
+            bp(l) = EXP( 1. - 1./(newsig**2)  )
+            ap(l) = pa * (newsig - bp(l) )
+         enddo
+         bp(llmp1) = 0.
+         ap(llmp1) = 0.
+      else
+         write(*,*) "****************************"
+         write(*,*) "Systeme en coordonnees sigma"
+         write(*,*) 
+c        Pour ne pas passer en coordonnees hybrides
+         DO l = 1, llm
+            ap(l) = 0.
+            bp(l) = sig(l)
+         ENDDO
+         ap(llmp1) = 0.
+      endif
+
+      bp(llmp1) =   0.
+
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+
+c     Calcul au milieu des couches :
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     Le calcul du niveau pour la derniere couche 
+c     (on met la meme distance (en log pression)  entre P(llm)
+c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
+c     Specifique.  Ce choix est spécifié ici ET dans exner_hyb.F
+
+      DO l = 1, llm-1
+       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
+       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
+      ENDDO
+     
+      if (hybrid) then
+         aps(llm) = aps(llm-1)**2 / aps(llm-2) 
+         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
+      else
+         bps(llm) = bps(llm-1)**2 / bps(llm-2) 
+         aps(llm) = 0.
+      end if
+
+      PRINT *,' BPs '
+      PRINT *,  bps
+      PRINT *,' APs'
+      PRINT *,  aps
+
+      DO l = 1, llm
+       presnivs(l) = aps(l)+bps(l)*preff
+       pseudoalt(l) = -10.*log(presnivs(l)/preff)
+      ENDDO
+
+      PRINT *,' PRESNIVS' 
+      PRINT *,presnivs 
+      PRINT *,'Pseudo altitude des Presnivs : ' 
+      PRINT *,pseudoalt
+
+c     --------------------------------------------------
+c     This can be used to plot the vertical discretization
+c     (> xmgrace -nxy testhybrid.tab       (z = H*log(p(l)/pref))
+c     --------------------------------------------------
+c     open (53,file='testhybrid.tab')
+c     do iz=0,60
+c       z = -10 + min(iz,60-iz)
+c       ps = preff*exp(-z/10)
+c       do l=1,llm
+c          zsig(l)= -10.*log((aps(l) + bps(l)*ps)/preff)
+c       end do
+c       write(53,*)iz, (zsig(l),l=1,llm,1)
+c      end do
+c      close(53)
+c     --------------------------------------------------
+
+
+      RETURN
+      END
+
+c ************************************************************
+      subroutine sig_hybrid(sig,pa,preff,newsig)
+c     ----------------------------------------------
+c     Subroutine utilisee pour calculer des valeurs de sigma modifie
+c     pour conserver les coordonnees verticales decrites dans
+c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
+c     F. Forget 2002
+c     Connaissant sig (niveaux "sigma" ou on veut mettre les couches)
+c     L'objectif est de calculer newsig telle que
+c       (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig
+c     Cela ne se résoud pas analytiquement: 
+c     => on résoud par iterration bourrine 
+c     ----------------------------------------------
+c     Information  : where exp(1-1./x**2) become << x
+c           x      exp(1-1./x**2) /x
+c           1           1
+c           0.68       0.5
+c           0.5        1.E-1
+c           0.391      1.E-2
+c           0.333      1.E-3
+c           0.295      1.E-4
+c           0.269      1.E-5
+c           0.248      1.E-6
+c        => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25
+
+
+      implicit none
+      real x1, x2, sig,pa,preff, newsig, F
+      integer j
+
+      newsig = sig
+      x1=0
+      x2=1
+	  if (sig.ge.1) then
+	       newsig= sig
+      else if (sig*preff/pa.ge.0.25) then
+        DO J=1,9999  ! nombre d''iteration max
+          F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
+c         write(0,*) J, ' newsig =', newsig, ' F= ', F
+          if (F.gt.1) then
+              X2 = newsig
+              newsig=(X1+newsig)*0.5
+          else
+              X1 = newsig
+              newsig=(X2+newsig)*0.5
+          end if
+c         Test : on arete lorsque on approxime sig à moins de 0.01 m près 
+c         (en pseudo altiude) :
+          IF(abs(10.*log(F)).LT.1.E-5) goto 999
+        END DO
+       else   !    if (sig*preff/pa.le.0.25) then
+	        newsig= sig*preff/pa
+       end if
+ 999   continue
+       Return
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg.F	(revision 46)
@@ -0,0 +1,83 @@
+      SUBROUTINE diverg(klevel,x,y,div)
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER   l,ij
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     =  
+     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
+     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) / apoln
+        sumyps = SSUM ( iim,aiy2,1 ) / apols
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn
+         div( ij + ip1jm, l ) =   sumyps
+        ENDDO
+  10  CONTINUE
+c
+
+ccc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
+      
+c
+        DO l = 1, klevel
+           DO ij = iip2,ip1jm
+            div(ij,l) = div(ij,l) * unsaire(ij) 
+          ENDDO
+        ENDDO
+c
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg_gam.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg_gam.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/diverg_gam.F	(revision 46)
@@ -0,0 +1,78 @@
+      SUBROUTINE diverg_gam(klevel,cuvscvgam,cvuscugam,unsairegam ,
+     *                       unsapolnga,unsapolsga,  x, y,  div )
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      REAL cuvscvgam(ip1jm),cvuscugam(ip1jmp1),unsairegam(ip1jmp1)
+      REAL unsapolnga,unsapolsga
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+      INTEGER   l,ij
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     = (  
+     *  cvuscugam( ij+1 ) * x( ij+1,l ) - cvuscugam( ij ) * x( ij , l) +
+     *  cuvscvgam(ij-iim) * y(ij-iim,l) - cuvscvgam(ij+1) * y(ij+1,l) )* 
+     *         unsairegam( ij+1 )
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) * unsapolnga
+        sumyps = SSUM ( iim,aiy2,1 ) * unsapolsga
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn 
+         div( ij + ip1jm, l ) =   sumyps 
+        ENDDO
+  10  CONTINUE
+c
+
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergf.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergf.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergf.F	(revision 46)
@@ -0,0 +1,83 @@
+      SUBROUTINE divergf(klevel,x,y,div)
+c
+c     P. Le Van
+c
+c  *********************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
+c     x et y...
+c              x et y  etant des composantes covariantes   ...
+c  *********************************************************************
+      IMPLICIT NONE
+c
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   ---------------------------------------------------------------------
+c
+c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
+c
+c   ---------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c    ..........          variables en arguments    ...................
+c
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER   l,ij
+c
+c    ...............     variables  locales   .........................
+
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+c    ...................................................................
+c
+      EXTERNAL  SSUM
+      REAL      SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+        DO  ij = iip2, ip1jm - 1
+         div( ij + 1, l )     =  
+     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
+     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 
+        ENDDO
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+        DO  ij = iip2,ip1jm,iip1
+         div( ij,l ) = div( ij + iim,l )
+        ENDDO
+c
+c     ....  calcul  aux poles  .....
+c
+        DO  ij  = 1,iim
+         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
+         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
+        ENDDO
+        sumypn = SSUM ( iim,aiy1,1 ) / apoln
+        sumyps = SSUM ( iim,aiy2,1 ) / apols
+c
+        DO  ij = 1,iip1
+         div(     ij    , l ) = - sumypn
+         div( ij + ip1jm, l ) =   sumyps
+        ENDDO
+  10  CONTINUE
+c
+
+        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
+      
+c
+        DO l = 1, klevel
+           DO ij = iip2,ip1jm
+            div(ij,l) = div(ij,l) * unsaire(ij) 
+          ENDDO
+        ENDDO
+c
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergst.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergst.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divergst.F	(revision 46)
@@ -0,0 +1,60 @@
+      SUBROUTINE divergst(klevel,x,y,div)
+      IMPLICIT NONE
+c
+c     P. Le Van
+c
+c  ******************************************************************
+c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. x et y...
+c           x et y  etant des composantes contravariantes   ...
+c  ****************************************************************
+c      x  et  y  sont des arguments  d'entree pour le s-prog
+c        div      est  un argument  de sortie pour le s-prog
+c
+c
+c   -------------------------------------------------------------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
+      INTEGER ij,l,i
+      REAL aiy1( iip1 ) , aiy2( iip1 )
+      REAL sumypn,sumyps
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c
+      DO 10 l = 1,klevel
+c
+      DO 1 ij = iip2, ip1jm - 1
+      div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l)
+   1  CONTINUE
+c
+c     ....  correction pour  div( 1,j,l)  ......
+c     ....   div(1,j,l)= div(iip1,j,l) ....
+c
+CDIR$ IVDEP
+      DO 3 ij = iip2,ip1jm,iip1
+      div( ij,l ) = div( ij + iim,l )
+   3  CONTINUE
+c
+c     ....  calcul  aux poles  .....
+c
+c
+      DO 5 i  = 1,iim
+      aiy1(i)= y(i,l)
+      aiy2(i)= y(i+ip1jmi1,l)
+   5  CONTINUE
+      sumypn = SSUM ( iim,aiy1,1 )
+      sumyps = SSUM ( iim,aiy2,1 )
+      DO 7 i = 1,iip1
+      div(     i    , l ) = - sumypn/iim
+      div( i + ip1jm, l ) =   sumyps/iim
+   7  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE divgrad (klevel,h, lh, divgra )
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c  Auteur :   P. Le Van
+c  ----------
+c
+c                              lh
+c      calcul de  (div( grad ))   de h  .....
+c      h  et lh  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comdissipn.h"
+#include "logic.h"
+c
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+
+      INTEGER  l,ij,iter,lh
+c
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, covcont, diverg
+c
+c
+      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
+c
+      DO 10 iter = 1,lh
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1  )
+
+      CALL grad (klevel,divgra, ghx  , ghy          )
+      CALL diverg (klevel,  ghx , ghy  , divgra       )
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
+
+      DO 5 l = 1,klevel
+      DO 4  ij = 1, ip1jmp1
+      divgra( ij,l ) = - cdivh * divgra( ij,l )
+   4  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad2.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad2.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad2.F	(revision 46)
@@ -0,0 +1,78 @@
+      SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
+c
+c     P. Le Van
+c
+c   ***************************************************************
+c
+c     .....   calcul de  (div( grad ))   de (  pext * h ) .....
+c   ****************************************************************
+c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
+c         divgra     est  un argument  de sortie pour le s-prg
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "comdissipn.h"
+
+c    .......    variables en arguments   .......
+c
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
+      REAL divgra( ip1jmp1,klevel)
+c
+c    .......    variables  locales    ..........
+c
+      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
+      INTEGER  l,ij,iter,lh
+c    ...................................................................
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY,  laplacien_gam
+c
+      signe    = (-1.)**lh
+      nudivgrs = signe * cdivh
+
+      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
+
+c
+      CALL laplacien( klevel, divgra, divgra )
+     
+      DO l = 1, klevel
+       DO ij = 1, ip1jmp1
+        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
+       ENDDO
+      ENDDO
+c
+      DO l = 1, klevel
+        DO ij = 1, ip1jmp1
+         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
+        ENDDO
+      ENDDO
+   
+c    ........    Iteration de l'operateur  laplacien_gam    ........
+c
+      DO  iter = 1, lh - 2
+       CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
+     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
+      ENDDO
+c
+c    ...............................................................
+ 
+      DO l = 1, klevel
+        DO ij = 1, ip1jmp1
+          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
+        ENDDO
+      ENDDO
+c
+      CALL laplacien ( klevel, divgra, divgra )
+c
+      DO l  = 1,klevel
+      DO ij = 1,ip1jmp1
+      divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad22.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad22.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/divgrad22.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE divgrad2_mars (klevel,h, lh, divgra )
+c
+c  P. Le Van
+c
+c   ************************************************************
+c
+c                                lh
+c        calcul de  (div( grad ))   de h  .....
+c   ************************************************************
+c      h  et lh  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+
+      INTEGER klevel
+      REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+      REAL signe, nudivgrs
+
+      INTEGER  l,ij,iter,lh
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, covcont, diverg, divergst
+
+
+      signe    = (-1.)**lh
+      nudivgrs = signe * cdivh
+
+      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
+
+      DO 2 iter = 1, lh -1
+      CALL grad (klevel,divgra, ghx  , ghy          )
+      CALL divergst (klevel,  ghx , ghy  , divgra       )
+   2  CONTINUE
+
+      CALL filtreg (divgra,jjp1,klevel,2,1,.true.,1)
+      CALL grad  (klevel,divgra, ghx, ghy      )
+      CALL covcont (klevel,ghx   , ghy, ghx ,ghy )
+      CALL diverg  (klevel,ghx   , ghy,divgra    )
+
+      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
+
+      DO 5 l = 1,klevel
+      DO 4  ij = 1, ip1jmp1
+      divgra( ij,l ) = nudivgrs * divgra( ij,l )
+   4  CONTINUE
+   5  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dteta1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dteta1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dteta1.F	(revision 46)
@@ -0,0 +1,67 @@
+      SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
+c
+c   ********************************************************************
+c   ... calcul du terme de convergence horizontale du flux d'enthalpie
+c        potentielle   ......
+c   ********************************************************************
+c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
+c     dteta 	          sont des arguments de sortie pour le s-pg ....
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+
+      REAL teta( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL dteta( ip1jmp1,llm )
+      INTEGER   l,ij
+
+      REAL hbyv( ip1jm,llm ), hbxu( ip1jmp1,llm )
+
+      EXTERNAL     convflu
+      EXTERNAL     filtreg
+c
+
+      DO 5 l = 1,llm
+
+      DO 1  ij = iip2, ip1jm - 1
+      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
+   1  CONTINUE
+
+c    .... correction pour  hbxu(iip1,j,l)  .....
+c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
+
+CDIR$ IVDEP
+      DO 2 ij = iip1+ iip1, ip1jm, iip1
+      hbxu( ij, l ) = hbxu( ij - iim, l )
+   2  CONTINUE
+
+
+      DO 3 ij = 1,ip1jm
+      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
+   3  CONTINUE
+
+   5  CONTINUE
+
+
+        CALL convflu ( hbxu, hbyv, llm, dteta )
+
+
+c    stockage dans  dh de la convergence horizont. filtree' du  flux
+c                  ....                           ...........
+c           d'enthalpie potentielle .
+
+      CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
+
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv1.F	(revision 46)
@@ -0,0 +1,50 @@
+      SUBROUTINE dudv1 ( vorpot, pbaru, pbarv, du, dv )
+      IMPLICIT NONE
+c
+c-----------------------------------------------------------------------
+c
+c   Auteur:   P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c   calcul du terme de  rotation
+c   ce terme est ajoute a  d(ucov)/dt et a d(vcov)/dt  ..
+c   vorpot, pbaru et pbarv sont des arguments d'entree  pour le s-pg ..
+c   du  et dv              sont des arguments de sortie pour le s-pg ..
+c
+c-----------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      REAL vorpot( ip1jm,llm ) ,pbaru( ip1jmp1,llm ) ,
+     *     pbarv( ip1jm,llm ) ,du( ip1jmp1,llm ) ,dv( ip1jm,llm )
+      INTEGER  l,ij
+c
+c
+      DO 10 l = 1,llm
+c
+      DO 2  ij = iip2, ip1jm - 1
+      du( ij,l ) = 0.125 *(  vorpot(ij-iip1, l) + vorpot( ij, l)  ) *
+     *                    (   pbarv(ij-iip1, l) + pbarv(ij-iim,  l) +
+     *                        pbarv(   ij  , l) + pbarv(ij+ 1 ,  l)   )
+   2  CONTINUE
+c
+      DO 3 ij = 1, ip1jm - 1
+      dv( ij+1,l ) = - 0.125 *(  vorpot(ij, l)  + vorpot(ij+1, l)  ) *
+     *                        (   pbaru(ij, l)  +  pbaru(ij+1   , l) +
+     *                       pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
+   3  CONTINUE
+c
+c    .... correction  pour  dv( 1,j,l )  .....
+c    ....   dv(1,j,l)= dv(iip1,j,l) ....
+c
+CDIR$ IVDEP
+      DO 4 ij = 1, ip1jm, iip1
+      dv( ij,l ) = dv( ij + iim, l )
+   4  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv2.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv2.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dudv2.F	(revision 46)
@@ -0,0 +1,60 @@
+      SUBROUTINE dudv2 ( teta, pkf, bern, du, dv  )
+
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   *****************************************************************
+c   ..... calcul du terme de pression (gradient de p/densite )   et
+c          du terme de ( -gradient de la fonction de Bernouilli ) ...
+c   *****************************************************************
+c          Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
+c
+c
+c    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
+c    du et dv          sont des arguments de sortie pour le s-pg  ....
+c
+c=======================================================================
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+      REAL teta( ip1jmp1,llm ),pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ),
+     *         du( ip1jmp1,llm ),  dv( ip1jm,llm )
+      INTEGER  l,ij
+c
+c
+      DO 5 l = 1,llm
+c
+      DO 2  ij  = iip2, ip1jm - 1
+       du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *
+     * ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
+   2  CONTINUE
+c
+c
+c    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
+c    ...          du(iip1,j,l) = du(1,j,l)                 ...
+c
+CDIR$ IVDEP
+      DO 3 ij = iip1+ iip1, ip1jm, iip1
+      du( ij,l ) = du( ij - iim,l )
+   3  CONTINUE
+c
+c
+      DO 4 ij  = 1,ip1jm
+      dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *
+     *                             ( pkf(ij+iip1,l) - pkf(  ij,l  ) )
+     *                           +   bern( ij+iip1,l ) - bern( ij  ,l )
+   4  CONTINUE
+c
+   5  CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dump2d.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dump2d.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dump2d.F	(revision 46)
@@ -0,0 +1,43 @@
+      SUBROUTINE dump2d(im,jm,z,nom_z)
+      IMPLICIT NONE
+      INTEGER im,jm
+      REAL z(im,jm)
+      CHARACTER (len=*) :: nom_z
+
+      INTEGER i,j,imin,illm,jmin,jllm
+      REAL zmin,zllm
+
+      PRINT*,nom_z
+
+      zmin=z(1,1)
+      zllm=z(1,1)
+      imin=1
+      illm=1
+      jmin=1
+      jllm=1
+
+      DO j=1,jm
+         DO i=1,im
+            IF(z(i,j).GT.zllm) THEN
+               illm=i
+               jllm=j
+               zllm=z(i,j)
+            ENDIF
+            IF(z(i,j).LT.zmin) THEN
+               imin=i
+               jmin=j
+               zmin=z(i,j)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      PRINT*,'MIN: ',zmin
+      PRINT*,'MAX: ',zllm
+
+      IF(zllm.GT.zmin) THEN
+      DO j=1,jm
+      WRITE(*,'(72i1)') (NINT(10.*(z(i,j)-zmin)/(zllm-zmin)),i=1,im)
+      ENDDO
+      ENDIF
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynetat0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynetat0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynetat0.F	(revision 46)
@@ -0,0 +1,422 @@
+      SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
+     .                    teta,q,masse,ps,phis,time)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van / L.Fairhead
+c   -------
+c
+c   objet:
+c   ------
+c
+c   Lecture de l'etat initial
+c
+c   Modifs: Oct.2008 read in tracers by name. Ehouarn Millour
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "logic.h"
+#include"advtrac.h"
+
+c   Arguments:
+c   ----------
+
+      CHARACTER*(*) fichnom
+      INTEGER nq
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL q(iip1,jjp1,llm,nq),masse(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+
+      REAL time
+
+c   Variables 
+c
+      INTEGER length,iq,i,j,l
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid, nqold
+      CHARACTER  str3*3,yes*1
+
+c-----------------------------------------------------------------------
+
+c  Ouverture NetCDF du fichier etat initial
+
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier ',fichnom
+        CALL ABORT
+      ENDIF
+
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+      cpp        = tab_cntrl(8)
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+      pa         = tab_cntrl(17)
+      preff      = tab_cntrl(18)
+c
+      clon       = tab_cntrl(19)
+      clat       = tab_cntrl(20)
+      grossismx  = tab_cntrl(21)
+      grossismy  = tab_cntrl(22)
+c
+      IF ( tab_cntrl(23).EQ.1. )  THEN
+        fxyhypb  = . TRUE .
+        dzoomx   = tab_cntrl(24)
+        dzoomy   = tab_cntrl(25)
+        taux     = tab_cntrl(27)
+        tauy     = tab_cntrl(28)
+      ELSE
+        fxyhypb = . FALSE .
+        ysinus  = . FALSE .
+        IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE. 
+      ENDIF
+c   .................................................................
+c
+c
+      PRINT*,'dynetat0: rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+ 
+      IF(   im.ne.iim           )  THEN
+          PRINT 1,im,iim
+          STOP
+      ELSE  IF( jm.ne.jjm       )  THEN
+          PRINT 2,jm,jjm
+          STOP
+      ELSE  IF( lllm.ne.llm     )  THEN
+          PRINT 3,lllm,llm
+          STOP
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlatu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlonv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <cu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <cu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <cv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <aire> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <aire>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <phisinit> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+	     ierr = NF_INQ_VARID (nid, "temps", nvarid)
+		 IF (ierr .NE. NF_NOERR) THEN
+           PRINT*, "dynetat0: <Time> or <temps> absent"
+           CALL abort
+         ENDIF
+      ENDIF
+#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*, "dynetat0: Lecture echouee <Time>/<temps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <ucov> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
+         CALL abort
+      ENDIF
+ 
+      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <vcov> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <teta> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <teta>"
+         CALL abort
+      ENDIF
+
+
+      IF(nq.GE.1) THEN
+        write(*,*) 'dynetat0: loading tracers'
+         IF(nq.GT.99) THEN
+            PRINT*, "Trop de traceurs"
+            CALL abort
+         ENDIF
+         nqold=nq
+         DO iq=1,nq
+!           str3(1:1)='q'
+!           WRITE(str3(2:3),'(i2.2)') iq
+!           ierr =  NF_INQ_VARID (nid, str3, nvarid)
+! NB: tracers are now read in using their name ('tnom' from advtrac.h)
+!           write(*,*) "  loading tracer:",trim(tnom(iq))
+           ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
+           IF (ierr .NE. NF_NOERR) THEN
+!              PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
+              PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
+     &                "> est absent"
+              PRINT*, "          Il est donc initialise a zero"
+              CALL initial0(ijp1llm,q(1,1,1,iq))
+              nqold=min(iq-1,nqold)
+           ELSE
+#ifdef NC_DOUBLE
+           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
+#else
+           ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
+#endif
+             IF (ierr .NE. NF_NOERR) THEN
+!                 PRINT*, "dynetat0: Lecture echouee pour "//str3
+               PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
+               CALL abort
+             ENDIF
+           ENDIF
+         ENDDO
+         if ((nqold.lt.nq).and.(nqold.ge.1)) then   
+c        case when new tracer are added in addition to old ones
+             write(*,*)'tracers 1 to ', nqold,'were already present'
+             write(*,*)'tracers ', nqold+1,' to ', nqmx,'are new'
+             yes=' '
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+             write(*,*) 'Would you like to reindex tracer # 1 ->',nqold
+             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
+             read(*,fmt='(a)') yes
+            end do
+            if (yes.eq.'y') then
+              write(*,*) 'OK, let s reindex the tracers'
+              do l=1,llm
+                do j=1,jjp1
+                  do i=1,iip1
+                    do iq=nqmx,nqmx-nqold+1,-1
+                       q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)   
+                    end do
+                    do iq=nqmx-nqold,1,-1
+                       q(i,j,l,iq)= 0.
+                    end do
+                  end do
+                end do
+              end do
+            end if 
+         end if
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <masse> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <masse>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_CLOSE(nid)
+
+       day_ini=day_ini+INT(time)
+       time=time-INT(time)
+
+  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
+     *arrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
+     *arrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
+     *rrage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
+     *rrage est differente de la valeur  dtinteg =',i4//)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynredem.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynredem.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/dynredem.F	(revision 46)
@@ -0,0 +1,1107 @@
+      SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
+      IMPLICIT NONE
+c=======================================================================
+c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
+c=======================================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "advtrac.h"
+c   Arguments:
+c   ----------
+      INTEGER*4 idayref,anneeref
+      REAL phis(ip1jmp1)
+      CHARACTER*(*) fichnom
+      INTEGER nq
+
+c   Local:
+c   ------
+      INTEGER iq,l
+      CHARACTER str3*3
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr
+      character*20 modname
+      character*80 abort_message
+      character(len=80) :: txt ! to store some text
+
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3), dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llm, idim_llmp1
+      INTEGER idim_tim
+      INTEGER nid,nvarid
+
+      REAL zan0,zjulian,hours
+      REAL sigs(llm)
+      INTEGER yyears0,jjour0, mmois0
+      data yyears0 /1/
+      data jjour0 /1/
+      data mmois0 /1/
+      character*30 unites
+
+
+c-----------------------------------------------------------------------
+      modname='dynredem'
+      do l=1,llm
+         sigs(l)=float(l)
+      enddo
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(idayref)
+       tab_cntrl(5)  = rad
+       tab_cntrl(6)  = omeg
+       tab_cntrl(7)  = g
+       tab_cntrl(8)  = cpp
+       tab_cntrl(9) = kappa
+       tab_cntrl(10) = daysec
+       tab_cntrl(11) = dtvr
+       tab_cntrl(12) = etot0
+       tab_cntrl(13) = ptot0
+       tab_cntrl(14) = ztot0
+       tab_cntrl(15) = stot0
+       tab_cntrl(16) = ang0
+       tab_cntrl(17) = pa
+       tab_cntrl(18) = preff
+c
+c    .....    parametres  pour le zoom      ......   
+
+       tab_cntrl(19)  = clon
+       tab_cntrl(20)  = clat
+       tab_cntrl(21)  = grossismx
+       tab_cntrl(22)  = grossismy
+c
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx
+       tab_cntrl(25) = dzoomy
+       tab_cntrl(26) = 0.
+       tab_cntrl(27) = taux
+       tab_cntrl(28) = tauy
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx
+       tab_cntrl(25) = dzoomy
+       tab_cntrl(26) = 0.
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       IF( ysinus )  tab_cntrl(26) = 1. 
+      ENDIF
+c
+c    .........................................................
+c
+c Creation du fichier:
+c
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+         WRITE(6,*)" Failed creating file "//fichnom
+         WRITE(6,*)' ierr = ', ierr
+         CALL ABORT
+      ENDIF
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
+     .                       "Dynamic start file")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title in file "//fichnom
+        call abort
+      endif
+c
+c Definir les dimensions du fichiers:
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <index> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <rlonu> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <latitude> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <longitude> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <rlatv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <altitude> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <interlayer> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining dimension <Time> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+c     ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+c     ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+c     ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+
+c
+c Definir et enregistrer certains champs invariants:
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <controle> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <controle> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <controle> ",
+     &             "in file "//fichnom
+        call abort
+!      else
+!       write(*,*) "dynredem0: controle(1)=",tab_cntrl(1)
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <rlonu> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <rlonu> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <rlonu> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <rlatu> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <rlatu> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <rlatu> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <rlonv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <rlonv> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <rlonv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <rlatv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <rlatv> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <rlatv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <ap> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .          "Coef A: hybrid pressure levels"  )
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <ap> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <ap> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <bp> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .      "Coef B: hybrid sigma levels")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <bp> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <bp> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+!      ierr = NF_REDEF (nid)
+!      if (ierr.ne.NF_NOERR) then
+!        write(*,*) "dynredem0: Failed to switch back to define mode"
+!        call abort
+!      endif
+!#ifdef NC_DOUBLE
+!      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+!#else
+!      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+!#endif
+!      if (ierr.ne.NF_NOERR) then
+!        write(*,*) "dynredem0: Failed defining <ap> ",
+!     &             "in file "//fichnom
+!        call abort
+!      endif
+!
+!      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+!     .          "Coef A: hybrid pressure levels"  )
+!      if (ierr.ne.NF_NOERR) then
+!        write(*,*) "dynredem0: Failed writing title attribute ",
+!     &             "for <ap> in file "//fichnom
+!
+!      ierr = NF_ENDDEF(nid)
+!      if (ierr.ne.NF_NOERR) then
+!        write(*,*) "dynredem0: Failed to switch out of define mode"
+!        call abort
+!      endif
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+!#else
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+!#endif
+!      if (ierr.ne.NF_NOERR) then
+!        write(*,*) "dynredem0: Failed writing <bp> ",
+!     &             "in file "//fichnom
+!        call abort
+!      endif
+c
+c ----------------------
+c
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <aps> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
+     .      "Coef AS: hybrid pressure at midlayers")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <aps> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <aps> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <bps> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
+     .      "Coef BS: hybrid sigma at midlayers")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute ",
+     &             "for <bps> in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <bps> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c
+c ----------------------
+c
+      ierr = NF_REDEF (nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <presniv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_ENDDEF(nid)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch out of define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing <presniv> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+c ------------------------------------------------------------------
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+  
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+  
+  
+c ----------------------
+c ----------------------
+c
+c Coefficients de passage cov. <-> contra. <--> naturel
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c ----------------------
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c ----------------------
+c Geopentiel au sol:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c ----------------------
+c Definir les variables pour pouvoir les enregistrer plus tard:
+c
+      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed to switch back to define mode"
+        call abort
+      endif
+
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
+#endif
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed defining <Time> ",
+     &             "in file "//fichnom
+        call abort
+      endif
+
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     &                       "Temps de simulation")
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing title attribute",
+     &             "for <Time> in file "//fichnom
+        call abort
+      endif
+
+
+      write(unites,200)yyears0,mmois0,jjour0
+200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
+     .                         unites)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) "dynredem0: Failed writing units attribute",
+     &             "for <Time> in file "//fichnom
+        call abort
+      endif
+
+
+c
+      dims4(1) = idim_rlonu
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse U")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatv
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse V")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
+     .                       "Temperature")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+      IF(nq.GE.1) THEN
+         DO iq=1,nq
+            IF (iq.GT.99) THEN
+               PRINT*, "Trop de traceurs"
+               CALL abort
+            ELSE
+!               str3(1:1)='q'
+!               WRITE(str3(2:3),'(i2.2)') iq
+!#ifdef NC_DOUBLE
+!               ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
+!#else
+!               ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
+!#endif
+!               ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+!     .                          "Traceurs "//str3)
+             txt="Traceur "//trim(tnom(iq))
+#ifdef NC_DOUBLE
+               ierr=NF_DEF_VAR(nid,tnom(iq),NF_DOUBLE,4,dims4,nvarid)
+#else
+               ierr=NF_DEF_VAR(nid,tnom(iq),NF_FLOAT,4,dims4,nvarid)
+#endif
+               ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",
+     .                  len_trim(txt),trim(txt))
+            ENDIF
+         ENDDO
+      ENDIF
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_llm
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+     .                       "C est quoi ?")
+c
+      dims3(1) = idim_rlonv
+      dims3(2) = idim_rlatu
+      dims3(3) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
+     .                       "Pression au sol")
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+      ierr = NF_CLOSE(nid) ! fermer le fichier
+
+      write(*,*)'dynredem0: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      write(*,*)'dynredem0: rad,omeg,g,cpp,kappa',
+     &        rad,omeg,g,cpp,kappa
+      
+!      stop "dynredem0 halt"
+      
+      RETURN
+      END
+
+c ================================================================
+c ================================================================
+
+      SUBROUTINE dynredem1(fichnom,time,
+     .                     vcov,ucov,teta,q,nq,masse,ps)
+      IMPLICIT NONE
+c=================================================================
+c  Ecriture du fichier de redemarrage sous format NetCDF
+c=================================================================
+#include "dimensions.h"
+#include "paramet.h"
+#include "description.h"
+#include "netcdf.inc"
+#include "comvert.h"
+#include "comgeom.h"
+#include"advtrac.h"
+
+      INTEGER nq, l
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
+      REAL teta(ip1jmp1,llm)                   
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
+      REAL q(iip1,jjp1,llm,nqmx)
+      REAL q3d(iip1,jjp1,llm) !temporary variable
+      CHARACTER*(*) fichnom
+     
+      REAL time
+      INTEGER nid, nvarid
+      INTEGER ierr
+      INTEGER iq
+      CHARACTER str3*3
+      character*20 modname
+      character*80 abort_message
+c
+      INTEGER nb,i,j
+      SAVE nb
+      DATA nb / 0 /
+
+      modname = 'dynredem1'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Pb. d ouverture "//fichnom
+         CALL abort
+      ENDIF
+
+c  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+      ierr = NF_INQ_VARID(nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         print *, NF_STRERROR(ierr)
+         abort_message='Variable Time n est pas definie'
+         CALL abort_gcm(modname,abort_message,ierr)
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
+#endif
+      PRINT*, "Enregistrement pour ", nb, time
+
+c  Ecriture des champs
+c
+      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ucov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable vcov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable teta n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
+#endif
+
+      IF (nq.GT.99) THEN
+         PRINT*, "Trop de traceurs"
+         CALL abort
+      ENDIF
+      IF(nq.GE.1) THEN
+         DO iq=1,nq
+!            str3(1:1)='q'
+!            WRITE(str3(2:3),'(i2.2)') iq
+!            ierr = NF_INQ_VARID(nid, str3, nvarid)
+            ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
+            IF (ierr .NE. NF_NOERR) THEN
+!               PRINT*, "Variable "//str3//" n est pas definie"
+              PRINT*, "Variable "//trim(tnom(iq))//" n est pas definie"
+              CALL abort
+            ENDIF
+            do l=1,llm
+               do j=1,jjp1
+                  do i=1,iip1
+                     q3d(i,j,l)=q(i,j,l,iq)
+                  enddo
+               enddo
+            enddo
+#ifdef NC_DOUBLE
+            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
+#else
+            ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
+#endif
+            IF (ierr .NE. NF_NOERR) THEN
+               PRINT*, "Error: ", NF_STRERROR(ierr)
+               CALL abort
+            ENDIF
+         ENDDO
+      ENDIF
+c
+      ierr = NF_INQ_VARID(nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable masse n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
+#endif
+c
+      ierr = NF_INQ_VARID(nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ps n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
+#endif
+
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/enercin.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/enercin.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/enercin.F	(revision 46)
@@ -0,0 +1,96 @@
+      SUBROUTINE enercin ( vcov, ucov, vcont, ucont, ecin )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur: P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c *********************************************************************
+c .. calcul de l'energie cinetique aux niveaux s  ......
+c *********************************************************************
+c  vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
+c  ecin         est  un  argument de sortie pour le s-pg
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL vcov( ip1jm,llm ),vcont( ip1jm,llm ),
+     * ucov( ip1jmp1,llm ),ucont( ip1jmp1,llm ),ecin( ip1jmp1,llm )
+
+      REAL ecinni( iip1 ),ecinsi( iip1 )
+
+      REAL ecinpn, ecinps
+      INTEGER     l,ij,i
+
+      EXTERNAL    SSUM
+      REAL        SSUM
+
+
+
+c                 . V
+c                i,j-1
+
+c      alpha4 .       . alpha1
+
+
+c        U .      . P     . U
+c       i-1,j    i,j      i,j
+
+c      alpha3 .       . alpha2
+
+
+c                 . V
+c                i,j
+
+c    
+c  L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
+c       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
+c              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
+c              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
+c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
+
+
+      DO 5 l = 1,llm
+
+      DO 1  ij = iip2, ip1jm -1
+      ecin( ij+1, l )  =    0.5  *
+     * (   ucov( ij   ,l ) * ucont( ij   ,l ) * alpha3p4( ij +1 )   +
+     *     ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 )   +
+     *     vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 )   +
+     *     vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 )   )
+   1  CONTINUE
+
+c    ... correction pour  ecin(1,j,l)  ....
+c    ...   ecin(1,j,l)= ecin(iip1,j,l) ...
+
+CDIR$ IVDEP
+      DO 2 ij = iip2, ip1jm, iip1
+      ecin( ij,l ) = ecin( ij + iim, l )
+   2  CONTINUE
+
+c     calcul aux poles  .......
+
+
+      DO 3 i = 1, iim
+      ecinni(i) = vcov(    i  ,  l) * vcont(    i    ,l) * aire(   i   )
+      ecinsi(i) = vcov(i+ip1jmi1,l) * vcont(i+ip1jmi1,l) * aire(i+ip1jm)
+   3  CONTINUE
+
+      ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln
+      ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols
+
+      DO 4 ij = 1,iip1
+      ecin(   ij     , l ) = ecinpn
+      ecin( ij+ ip1jm, l ) = ecinps
+   4  CONTINUE
+
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner.F	(revision 46)
@@ -0,0 +1,29 @@
+      SUBROUTINE exner(ngrid,pext,aire,pks,pksf)
+      IMPLICIT NONE
+
+c      .........    Version du 16/04/96     .........
+c
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "comconst.h"
+
+      INTEGER ngrid
+      REAL pext(ngrid),aire(ngrid),pks(ngrid),pksf(ngrid)
+
+      INTEGER ig,iii
+
+      EXTERNAL filtreg
+
+c-----------------------------------------------------------------------
+
+      DO 3 ig = 1,ngrid
+         pks( ig )     = ( pext( ig )/ aire( ig ) ) ** kappa
+         pksf( ig )    = pks( ig )
+   3  CONTINUE
+
+      CALL filtreg (pksf,jmp1,1,2,1,.true.,1)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner_hyb.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner_hyb.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/exner_hyb.F	(revision 46)
@@ -0,0 +1,102 @@
+      SUBROUTINE  exner_hyb ( ngrid, ps, p,beta, pks, pk, pkf )
+c
+c     Auteurs :  F. Forget , Y. Wanherdrick
+c P.Le Van  , Fr. Hourdin  .
+c    ..........
+c
+c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
+c    .... beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
+c
+c   ************************************************************************
+c    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des 
+c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+c   ************************************************************************
+c    .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+c    la pression et la fonction d'Exner  au  sol  .
+c
+c     WARNING : CECI est une version speciale de exner_hyb originale
+c               Utilis dans la version martienne pour pouvoir 
+c               tourner avec des coordonnes verticales complexe
+c              => Il ne verifie PAS la condition la proportionalit en 
+c              nergie totale/ interne / potentielle (F.Forget 2001)
+c    ( voir note de Fr.Hourdin )  ,
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "serre.h"
+
+      INTEGER  ngrid
+      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
+      REAL ps(ngrid),pks(ngrid), beta(ngrid,llm)
+
+c    .... variables locales   ...
+
+      INTEGER l, ij
+      REAL dum1
+
+      REAL ppn(iim),pps(iim)
+      REAL xpn, xps
+      REAL SSUM
+      EXTERNAL filtreg, SSUM
+      
+c     -------------
+c     Calcul de pks
+c     -------------
+   
+      DO   ij  = 1, ngrid
+        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+      ENDDO
+
+      DO  ij   = 1, iim
+        ppn(ij) = aire(   ij   ) * pks(  ij     )
+        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+      ENDDO
+      xpn      = SSUM(iim,ppn,1) /apoln
+      xps      = SSUM(iim,pps,1) /apols
+
+      DO ij   = 1, iip1
+        pks(   ij     )  =  xpn
+        pks( ij+ip1jm )  =  xps
+      ENDDO
+c
+c
+c    .... Calcul de pk  pour la couche l 
+c    --------------------------------------------
+c
+      dum1 = cpp * (2*preff)**(-kappa) 
+      DO l = 1, llm-1
+        DO   ij   = 1, ngrid
+         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
+        ENDDO
+      ENDDO
+
+c    .... Calcul de pk  pour la couche l = llm ..
+c    (on met la meme distance (en log pression)  entre Pk(llm)
+c    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
+
+      DO   ij   = 1, ngrid
+         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
+      ENDDO
+
+
+c    calcul de pkf
+c    -------------
+      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
+      
+c    EST-CE UTILE ?? : calcul de beta
+c    --------------------------------
+      DO l = 2, llm
+        DO   ij   = 1, ngrid
+          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/flumass.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/flumass.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/flumass.F	(revision 46)
@@ -0,0 +1,107 @@
+      SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van, F. Hourdin  .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c *********************************************************************
+c     .... calcul du flux de masse  aux niveaux s ......
+c *********************************************************************
+c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
+c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL massebx( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
+     * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
+     * pbarv( ip1jm,llm )
+
+      REAL apbarun( iip1 ),apbarus( iip1 )
+
+      REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
+      INTEGER  l,ij,i
+
+      EXTERNAL   SSUM
+      REAL       SSUM
+
+
+      DO  5 l = 1,llm
+
+      DO  1 ij = iip2,ip1jm
+      pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
+   1  CONTINUE
+
+      DO 3 ij = 1,ip1jm
+      pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
+   3  CONTINUE
+
+   5  CONTINUE
+
+c    ................................................................
+c     calcul de la composante du flux de masse en x aux poles .......
+c    ................................................................
+c     par la resolution d'1 systeme de 2 equations .
+
+c     la premiere equat.decrivant le calcul de la divergence en 1 point i
+c     du pole,ce calcul etant itere de i=1 a i=im .
+c                 c.a.d   ,
+c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
+c                                           - somme de ( pbarv(n) )/aire pole
+
+c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
+c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
+
+c     on en revient ainsi a determiner la constante additive commune aux pbaru
+c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
+c     i=1 .
+c     i variant de 1 a im
+c     n variant de 1 a im
+
+      sairen = SSUM( iim,  aire(   1     ), 1 )
+      saireun= SSUM( iim, aireu(   1     ), 1 )
+      saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
+      saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
+
+      DO 20 l = 1,llm
+
+      ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
+      cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
+
+      pbaru(    1   ,l )=   pbarv(    1     ,l ) - ctn * aire(    1    )
+      pbaru( ip1jm+1,l )= - pbarv( ip1jmi1+1,l ) + cts * aire( ip1jm+1 )
+
+      DO 11 i = 2,iim
+      pbaru(    i    ,l ) = pbaru(   i - 1   ,l )    +
+     *                      pbarv(    i      ,l ) - ctn * aire(   i    )
+
+      pbaru( i+ ip1jm,l ) = pbaru( i+ ip1jm-1,l )    -
+     *                      pbarv( i+ ip1jmi1,l ) + cts * aire(i+ ip1jm)
+  11  CONTINUE
+      DO 12 i = 1,iim
+      apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
+      apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
+  12  CONTINUE
+      ctn0 = -SSUM( iim,apbarun,1 )/saireun
+      cts0 = -SSUM( iim,apbarus,1 )/saireus
+      DO 14 i = 1,iim
+      pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
+      pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
+  14  CONTINUE
+
+      pbaru(   iip1 ,l ) = pbaru(    1    ,l )
+      pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
+  20  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fluxstoke.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fluxstoke.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fluxstoke.F	(revision 46)
@@ -0,0 +1,149 @@
+      SUBROUTINE fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "tracstoke.h"
+
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
+      REAL phis(ip1jmp1)
+
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
+
+      REAL pbarvst(iip1,jjp1,llm)
+
+
+      INTEGER iadvtr 
+      INTEGER ij,l,irec,i,j
+ 
+      SAVE iadvtr, massem,pbaruc,pbarvc,irec
+      SAVE phic,tetac
+      logical first
+      save first
+      data first/.true./
+      DATA iadvtr/0/
+
+      if(first) then
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
+#endif
+         open(47,file='fluxmass',form='unformatted',
+     s        access='direct',recl=4*(6*ijp1llm))
+         irec=1
+         first=.false.
+
+         open(77,file='fluxmass.ctl',status='unknown',form='formatted')
+
+      endif
+
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,phic)
+         CALL initial0(ijp1llm,tetac)
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
+            phic(ij,l) = phic(ij,l) + phi(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+      ENDIF
+
+      iadvtr   = iadvtr+1
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.istdyn ) THEN
+
+c    normalisation
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
+            tetac(ij,l) = tetac(ij,l)/float(istdyn)
+            phic(ij,l) = phic(ij,l)/float(istdyn)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+         ENDDO
+      ENDDO
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvst(i,j,l)=pbarvg(i,j,l)
+              enddo
+           enddo
+           do i=1,iip1
+              pbarvst(i,jjp1,l)=0.
+           enddo
+        enddo
+
+         iadvtr=0
+
+         irec=irec+1
+         write(47,rec=1) float(irec),dtvr,float(istdyn),
+     s    float(iim),float(jjm),float(llm),rlonu,rlonv,rlatu,rlatv
+     s    ,aire,phis
+         write(47,rec=irec) massem,pbarug,pbarvst,wg,tetac,phic
+
+c   on reinitialise a zero les flux de masse cumules.
+
+      write(77,'(a4,2x,a40)')
+     &       'DSET ','^fluxmass'
+
+      write(77,'(a12)') 'UNDEF 1.0E30'
+      write(77,'(a5,1x,a40)') 'TITLE ','Titre a voir'
+      call formcoord(77,iip1,rlonv,180./pi,.false.,'XDEF')
+      call formcoord(77,jjp1,rlatu,180./pi,.true.,'YDEF')
+      call formcoord(77,llm,presnivs,1.,.false.,'ZDEF')
+      write(77,'(a4,i10,a30)')
+     &       'TDEF ',irec,' LINEAR 02JAN1987 1DY '
+      write(77,'(a4,2x,i5)') 'VARS',6
+      write(77,1000) 'masse',llm,99,'masse    '
+      write(77,1000) 'pbaru',llm,99,'pbaru    '
+      write(77,1000) 'pbarv',llm,99,'pbarv    '
+      write(77,1000) 'w    ',llm,99,'w        '
+      write(77,1000) 'teta ',llm,99,'teta     '
+      write(77,1000) 'phi  ',llm,99,'phi      '
+      write(77,'(a7)') 'ENDVARS'
+
+1000  format(a5,3x,i4,i3,1x,a39)
+
+
+
+      ENDIF ! if iadvtr.EQ.istdyn
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxhyp.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxhyp.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxhyp.F	(revision 46)
@@ -0,0 +1,448 @@
+       SUBROUTINE fxhyp ( xzoomdeg,grossism,dzoom,tau ,
+     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
+     , champmin,champmax                                               )
+
+c      Auteur :  P. Le Van 
+
+       IMPLICIT NONE
+
+c    Calcule les longitudes et derivees dans la grille du GCM pour une
+c     fonction f(x) a tangente  hyperbolique  .
+c
+c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)
+c     dzoom  etant  la distance totale de la zone du zoom
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom
+c
+c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.
+c   ********************************************************************
+
+
+       INTEGER nmax, nmax2
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+       LOGICAL scal180
+       PARAMETER ( scal180 = .TRUE. )
+
+c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour   
+c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.
+c      sinon scal180 = .FALSE.
+
+#include "dimensions.h"
+#include "paramet.h"
+       
+c     ......  arguments  d'entree   .......
+c
+       REAL xzoomdeg,dzoom,tau,grossism
+
+c    ......   arguments  de  sortie  ......
+
+       REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),
+     ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)
+
+c     .... variables locales  ....
+c
+       REAL*8 xlon(iip1),xprimm(iip1),xuv
+       REAL*8 xtild(0:nmax2)
+       REAL*8 fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
+       REAL*8 Xf(0:nmax2),xxpr(0:nmax2)
+       REAL*8 xvrai(iip1),xxprim(iip1) 
+       REAL*8 pi,depi,epsilon,xzoom,fa,fb
+       REAL*8 Xf1, Xfi , a0,a1,a2,a3,xi2
+       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
+       REAL*8 xi,xo1,xmoy,xlon2,fxm,Xprimin
+       REAL*8 champmin,champmax,decalx
+       INTEGER is2
+       SAVE is2
+
+       REAL*8 heavyside
+       EXTERNAL coefpoly,heavyside
+
+       pi       = 2. * ASIN(1.)
+       depi     = 2. * pi
+       epsilon  = 1.e-3
+       xzoom    = xzoomdeg * pi/180. 
+c
+           decalx   = .75
+       IF( grossism.EQ.1..AND.scal180 )  THEN
+           decalx   = 1.
+       ENDIF
+
+       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
+c
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * depi
+       ELSEIF( dzoom.LT. 25. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fxhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) xzoom,grossism,tau,dzoom
+
+       DO i = 0, nmax2 
+        xtild(i) = - pi + FLOAT(i) * depi /nmax2
+       ENDDO
+
+       DO i = nmax, nmax2
+
+       fa  = tau*  ( dzoom/2.  - xtild(i) )
+       fb  = xtild(i) *  ( pi - xtild(i) )
+
+         IF( 200.* fb .LT. - fa )   THEN
+           fhyp ( i) = - 1.
+         ELSEIF( 200. * fb .LT. fa ) THEN
+           fhyp ( i) =   1.
+         ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fhyp ( i ) = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fhyp ( i )  =   1.
+                ENDIF
+            ELSE
+                    fhyp ( i )  =  TANH ( fa/fb )
+            ENDIF
+         ENDIF
+
+        IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.
+        IF ( xtild(i).EQ. pi )  fhyp(i) = -1.
+
+       ENDDO
+
+cc  ....  Calcul  de  beta  ....
+c   ............................
+
+       ffdx = 0.
+
+       DO i = nmax +1,nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fxm   = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fxm   =   1.
+                ENDIF
+            ELSE
+                    fxm   =  TANH ( fa/fb )
+            ENDIF
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm  =  1.
+       IF ( xmoy.EQ. pi )  fxm  = -1.
+
+       ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )
+
+       ENDDO
+
+        beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fxhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
+     , ' et relancer ! ***  '
+        CALL ABORT
+       ENDIF
+c
+c   .....  calcul  de  Xprimt   .....
+c
+       
+       DO i = nmax, nmax2
+        Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)
+       ENDDO
+c   
+       DO i =  nmax+1, nmax2
+        Xprimt( nmax2 - i ) = Xprimt( i )
+       ENDDO
+c
+
+c   .....  Calcul  de  Xf     ........
+
+       Xf(0) = - pi
+
+       DO i =  nmax +1, nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+         fxm =  TANH ( fa/fb )
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm =  1.
+       IF ( xmoy.EQ. pi )  fxm = -1.
+       xxpr(i)    = beta + ( grossism - beta ) * fxm
+
+       ENDDO
+
+       DO i = nmax+1, nmax2
+        xxpr(nmax2-i+1) = xxpr(i)
+       ENDDO
+
+        DO i=1,nmax2
+         Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )
+        ENDDO
+
+
+c    *****************************************************************
+c
+
+c     .....  xuv = 0.   si  calcul  aux pts   scalaires   ........
+c     .....  xuv = 0.5  si  calcul  aux pts      U        ........
+c
+      WRITE(6,18)
+c
+      DO 5000  ik = 1, 4
+
+       IF( ik.EQ.1 )        THEN
+         xuv =  -0.25
+       ELSE IF ( ik.EQ.2 )  THEN
+         xuv =   0.
+       ELSE IF ( ik.EQ.3 )  THEN
+         xuv =   0.50
+       ELSE IF ( ik.EQ.4 )  THEN
+         xuv =   0.25
+       ENDIF
+
+      xo1   = 0.
+
+      ii1=1
+      ii2=iim
+      IF(ik.EQ.1.and.grossism.EQ.1.) THEN
+        ii1 = 2 
+        ii2 = iim+1
+      ENDIF
+
+      DO 1500 i = ii1, ii2
+
+      xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
+
+      Xfi    = xlon2
+c
+      DO 250 it =  nmax2,0,-1
+      IF( Xfi.GE.Xf(it))  GO TO 350
+250   CONTINUE
+
+      it = 0
+
+350   CONTINUE
+
+c    ......  Calcul de   Xf(xi)    ...... 
+c
+      xi  = xtild(it)
+
+      IF(it.EQ.nmax2)  THEN
+       it       = nmax2 -1
+       Xf(it+1) = pi
+      ENDIF
+c  .....................................................................
+c
+c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un
+c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )
+c          et (Xf(it+1),xtild(it+1) )
+
+       CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),
+     ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )
+
+       Xf1     = Xf(it)
+       Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
+
+       DO 500 iter = 1,300
+        xi = xi - ( Xf1 - Xfi )/ Xprimin
+
+        IF( ABS(xi-xo1).LE.epsilon)  GO TO 550
+         xo1      = xi
+         xi2      = xi * xi
+         Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi
+         Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2
+500   CONTINUE
+        WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter
+          STOP 6
+550   CONTINUE
+
+       xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )
+       xvrai(i)  =  xi + xzoom
+
+1500   CONTINUE
+
+
+       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
+         xvrai(1)    = xvrai(iip1)-depi
+         xxprim(1)   = xxprim(iip1)
+       ENDIF
+       DO i = 1 , iim
+        xlon(i)     = xvrai(i)
+        xprimm(i)   = xxprim(i)
+       ENDDO
+  
+       DO i = 1, iim -1
+        IF( xvrai(i+1). LT. xvrai(i) )  THEN
+         WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,
+     ,  ')'
+        STOP 7
+        ENDIF
+       ENDDO
+c
+c   ... Reorganisation  des  longitudes  pour les avoir  entre - pi et pi ..
+c   ........................................................................
+
+       champmin =  1.e12
+       champmax = -1.e12
+       DO i = 1, iim
+        champmin = MIN( champmin,xvrai(i) )
+        champmax = MAX( champmax,xvrai(i) )
+       ENDDO
+
+      IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN
+                GO TO 1600
+      ELSE
+       WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',
+     ,  ' et pi '
+c
+        IF( xzoom.LE.0.)  THEN
+          IF( ik.EQ. 1 )  THEN
+          DO i = 1, iim
+           IF( xvrai(i).GE. - pi )  GO TO 80
+          ENDDO
+            WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '
+            STOP 8
+ 80       CONTINUE
+          is2 = i
+          ENDIF
+
+          IF( is2.NE. 1 )  THEN
+            DO ii = is2 , iim
+             xlon  (ii-is2+1) = xvrai(ii)
+             xprimm(ii-is2+1) = xxprim(ii)
+            ENDDO
+            DO ii = 1 , is2 -1
+             xlon  (ii+iim-is2+1) = xvrai(ii) + depi
+             xprimm(ii+iim-is2+1) = xxprim(ii) 
+            ENDDO
+          ENDIF
+        ELSE 
+          IF( ik.EQ.1 )  THEN
+           DO i = iim,1,-1
+             IF( xvrai(i).LE. pi ) GO TO 90
+           ENDDO
+             WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '
+              STOP 9
+ 90        CONTINUE
+            is2 = i
+          ENDIF
+           idif = iim -is2
+           DO ii = 1, is2
+            xlon  (ii+idif) = xvrai(ii)
+            xprimm(ii+idif) = xxprim(ii)
+           ENDDO
+           DO ii = 1, idif
+            xlon (ii)  = xvrai (ii+is2) - depi
+            xprimm(ii) = xxprim(ii+is2) 
+           ENDDO
+         ENDIF
+      ENDIF
+c
+c     .........   Fin  de la reorganisation   ............................
+
+ 1600    CONTINUE
+
+
+         xlon  ( iip1)  = xlon(1) + depi
+         xprimm( iip1 ) = xprimm (1 )
+       
+         DO i = 1, iim+1
+         xvrai(i) = xlon(i)*180./pi
+         ENDDO
+
+         IF( ik.EQ.1 )  THEN
+c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '
+c          WRITE(6,18) 
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim +1
+             rlonm025(i) = xlon( i )
+            xprimm025(i) = xprimm(i)
+           ENDDO
+           
+         ELSE IF( ik.EQ.2 )  THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonv(i) = xlon( i )
+            xprimv(i) = xprimm(i)
+           ENDDO
+
+         ELSE IF( ik.EQ.3)   THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonu(i) = xlon( i )
+            xprimu(i) = xprimm(i)
+           ENDDO
+
+         ELSE IF( ik.EQ.4 )  THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim + 1
+             rlonp025(i) = xlon( i )
+            xprimp025(i) = xprimm(i)
+           ENDDO
+
+         ENDIF
+
+5000    CONTINUE
+c
+       WRITE(6,18)
+c
+c    ...........  fin  de la boucle  do 5000      ............
+
+        DO i = 1, iim
+         xlon(i) = rlonv(i+1) - rlonv(i)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO i = 1, iim
+         champmin = MIN( champmin, xlon(i) )
+         champmax = MAX( champmax, xlon(i) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+18     FORMAT(/)
+24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)
+68     FORMAT(1x,7f9.2)
+566    FORMAT(1x,7f9.4)
+
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxy.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxy.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxy.F	(revision 46)
@@ -0,0 +1,66 @@
+      SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+      IMPLICIT NONE
+
+c     Auteur  :  P. Le Van
+c
+c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
+c           a tangente sinusoidale et eventuellement avec zoom  .
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "serre.h"
+#include "comconst.h"
+
+       INTEGER i,j
+
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+
+#include "fxy_new.h"
+
+
+c    ......  calcul  des  latitudes  et de y'   .....
+c
+       DO j = 1, jjm + 1 
+          rlatu(j) = fy    ( FLOAT( j )        )
+         yprimu(j) = fyprim( FLOAT( j )        )
+       ENDDO
+
+
+       DO j = 1, jjm
+
+         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
+         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+
+        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
+        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+
+       ENDDO
+
+c
+c     .....  calcul   des  longitudes et de  x'   .....
+c
+       DO i = 1, iim + 1
+           rlonv(i)     = fx    (   FLOAT( i )          )
+           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
+        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
+        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+
+         xprimv  (i)    = fxprim (  FLOAT( i )          )
+         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+       ENDDO
+
+c
+       RETURN
+       END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxyhyper.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxyhyper.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxyhyper.F	(revision 46)
@@ -0,0 +1,137 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/fxyhyper.F,v 1.4 2001/04/24 13:12:44 lmdz Exp $
+c
+       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
+     ,                       xzoom, grossx, dzoomx,taux  ,
+     , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  , 
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       IMPLICIT NONE
+c
+c      Auteur :  P. Le Van .
+c
+c      d'apres  formulations de R. Sadourny .
+c
+c
+c     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )
+c            par des  fonctions  a tangente hyperbolique .
+c
+c     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom
+c                      et  yzoom )   :  
+c
+c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
+c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
+c     c) la raideur de la transition du zoom  :   taux et tauy   
+c
+c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
+c ******
+c                  et              grossy * dzoomy <  pi/2  ( radians )
+c
+#include "dimensions.h"
+#include "paramet.h"
+
+
+c   .....  Arguments  ...
+c
+       REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+       REAL*8  dxmin, dxmax , dymin, dymax
+
+c   ....   var. locales   .....
+c
+       INTEGER i,j
+c
+
+       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  , 
+     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  dymin,dymax                                               )
+
+       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
+     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
+
+
+        DO i = 1, iip1
+          IF(rlonp025(i).LT.rlonv(i))  THEN
+           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
+            STOP
+          ENDIF
+
+          IF(rlonv(i).LT.rlonm025(i))  THEN 
+           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
+            STOP
+          ENDIF
+
+          IF(rlonp025(i).GT.rlonu(i))  THEN
+           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
+            STOP
+          ENDIF
+        ENDDO
+
+        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
+
+c
+       DO j = 1, jjm
+c
+       IF(rlatu1(j).LE.rlatu2(j))   THEN
+         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
+         STOP 13
+       ENDIF
+c
+       IF(rlatu2(j).LE.rlatu(j+1))  THEN
+        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
+        STOP 14
+       ENDIF
+c
+       IF(rlatu(j).LE.rlatu1(j))    THEN
+        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
+        STOP 15
+       ENDIF
+c
+       IF(rlatv(j).LE.rlatu2(j))    THEN
+        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
+        STOP 16
+       ENDIF
+c
+       IF(rlatv(j).ge.rlatu1(j))    THEN
+        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
+        STOP 17
+       ENDIF
+c
+       IF(rlatv(j).ge.rlatu(j))     THEN
+        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
+        STOP 18
+       ENDIF
+c
+       ENDDO
+c
+       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
+c
+        WRITE(6,18)
+        WRITE(6,*) '  Latitudes  '
+        WRITE(6,*) ' *********** '
+        WRITE(6,18)
+        WRITE(6,3)  dymin, dymax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+c
+        WRITE(6,18)
+        WRITE(6,*) '  Longitudes  '
+        WRITE(6,*) ' ************ '
+        WRITE(6,18)
+        WRITE(6,3)  dxmin, dxmax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+        WRITE(6,18)
+c
+3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
+     ,  ' d environ ',f8.2 ,' degres  ',
+     , ' alors que la maille en dehors de la zone du zoom est d environ
+     , ', f8.2,' degres ' )
+18      FORMAT(/)
+
+       RETURN
+       END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxysinus.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxysinus.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fxysinus.F	(revision 46)
@@ -0,0 +1,66 @@
+      SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+
+      IMPLICIT NONE
+c
+c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
+c            avec y = Asin( j )  .
+c
+c     Auteur  :  P. Le Van
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+       INTEGER i,j
+
+       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
+     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
+
+#include "fxy_sin.h"
+
+
+c    ......  calcul  des  latitudes  et de y'   .....
+c
+       DO j = 1, jjm + 1 
+          rlatu(j) = fy    ( FLOAT( j )        )
+         yprimu(j) = fyprim( FLOAT( j )        )
+       ENDDO
+
+
+       DO j = 1, jjm
+
+         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
+         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+
+        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
+        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+
+       ENDDO
+
+c
+c     .....  calcul   des  longitudes et de  x'   .....
+c
+       DO i = 1, iim + 1
+           rlonv(i)     = fx    (   FLOAT( i )          )
+           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
+        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
+        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+
+         xprimv  (i)    = fxprim (  FLOAT( i )          )
+         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+       ENDDO
+
+c
+       RETURN
+       END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fyhyp.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fyhyp.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/fyhyp.F	(revision 46)
@@ -0,0 +1,376 @@
+C
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/fyhyp.F,v 1.5 2001/07/04 10:46:06 lmdz Exp $
+c
+       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom,tau  ,  
+     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  champmin,champmax                                            ) 
+
+cc    ...  Version du 01/04/2001 ....
+
+       IMPLICIT NONE
+c
+c    ...   Auteur :  P. Le Van  ... 
+c
+c    .......    d'apres  formulations  de R. Sadourny  .......
+c
+c     Calcule les latitudes et derivees dans la grille du GCM pour une
+c     fonction f(y) a tangente  hyperbolique  .
+c
+c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
+c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
+c
+c
+c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
+c      ********************************************************************
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+
+       INTEGER      nmax , nmax2
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+c
+c     .......  arguments  d'entree    .......
+c
+       REAL yzoomdeg, grossism,dzoom,tau 
+c         ( rentres  par  run.def )
+
+c     .......  arguments  de sortie   .......
+c
+       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
+     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
+
+c
+c     .....     champs  locaux    .....
+c
+     
+       REAL*8 ylat(jjp1), yprim(jjp1)
+       REAL*8 yuv
+       REAL*8 yt(0:nmax2)
+       REAL*8 fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
+       SAVE Ytprim, yt,Yf
+       REAL*8 Yf(0:nmax2),yypr(0:nmax2)
+       REAL*8 yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
+       REAL*8 pi,depi,pis2,epsilon,y0,pisjm
+       REAL*8 yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
+       REAL*8 yfi,Yf1,ffdy
+       REAL*8 ypn,deply,y00
+       SAVE y00, deply
+
+       INTEGER i,j,it,ik,iter,jlat
+       INTEGER jpn,jjpn
+       SAVE jpn
+       REAL*8 a0,a1,a2,a3,yi2,heavyy0,heavyy0m
+       REAL*8 fa(0:nmax2),fb(0:nmax2)
+       REAL y0min,y0max
+
+       REAL*8     heavyside
+       EXTERNAL   heavyside
+
+       pi       = 2. * ASIN(1.)
+       depi     = 2. * pi
+       pis2     = pi/2.
+       pisjm    = pi/ FLOAT(jjm)
+       epsilon  = 1.e-3
+       y0       =  yzoomdeg * pi/180. 
+
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * pi
+       ELSEIF( dzoom.LT. 12. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,18)
+       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) y0,grossism,tau,dzoom
+
+       DO i = 0, nmax2 
+        yt(i) = - pis2  + FLOAT(i)* pi /nmax2
+       ENDDO
+
+       heavyy0m = heavyside( -y0 )
+       heavyy0  = heavyside(  y0 )
+       y0min    = 2.*y0*heavyy0m - pis2
+       y0max    = 2.*y0*heavyy0  + pis2
+
+       fa = 999.999
+       fb = 999.999
+
+       DO i = 0, nmax2 
+        IF( yt(i).LT.y0 )  THEN
+         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
+         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
+        ELSEIF ( yt(i).GT.y0 )  THEN
+         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
+         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
+       ENDIF
+        
+       IF( 200.* fb(i) .LT. - fa(i) )   THEN
+         fhyp ( i) = - 1.
+       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fhyp ( i) =   1.
+       ELSE  
+         fhyp(i) =  TANH ( fa(i)/fb(i) )
+       ENDIF
+
+       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
+       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
+
+       ENDDO
+
+cc  ....  Calcul  de  beta  ....
+c
+       ffdy   = 0.
+
+       DO i = 1, nmax2
+        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
+        IF( ymoy.LT.y0 )  THEN
+         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
+         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
+        ELSEIF ( ymoy.GT.y0 )  THEN
+         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
+         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
+        ENDIF
+
+        IF( 200.* fb(i) .LT. - fa(i) )    THEN
+         fxm ( i) = - 1.
+        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fxm ( i) =   1.
+        ELSE
+         fxm(i) =  TANH ( fa(i)/fb(i) )
+        ENDIF
+         IF( ymoy.EQ.y0 )  fxm(i) = 1.
+         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
+         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
+
+        ENDDO
+
+        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fyhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
+     , ' et relancer ! ***  '
+        CALL ABORT
+
+       ENDIF
+c
+c   .....  calcul  de  Ytprim   .....
+c
+       
+       DO i = 0, nmax2
+        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
+       ENDDO
+
+c   .....  Calcul  de  Yf     ........
+
+       Yf(0) = - pis2
+       DO i = 1, nmax2
+        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
+       ENDDO
+
+       DO i=1,nmax2
+        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
+       ENDDO
+
+c    ****************************************************************
+c
+c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
+c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
+c
+      WRITE(6,18)
+c
+      DO 5000  ik = 1,4
+
+       IF( ik.EQ.1 )  THEN
+         yuv  = 0.
+         jlat = jjm + 1
+       ELSE IF ( ik.EQ.2 )  THEN
+         yuv  = 0.5
+         jlat = jjm 
+       ELSE IF ( ik.EQ.3 )  THEN
+         yuv  = 0.25
+         jlat = jjm 
+       ELSE IF ( ik.EQ.4 )  THEN
+         yuv  = 0.75
+         jlat = jjm 
+       ENDIF
+c
+       yo1   = 0.
+       DO 1500 j =  1,jlat
+        yo1   = 0.
+        ylon2 =  - pis2 + pisjm * ( FLOAT(j)  + yuv  -1.)  
+        yfi    = ylon2
+c
+       DO 250 it =  nmax2,0,-1
+        IF( yfi.GE.Yf(it))  GO TO 350
+250    CONTINUE
+       it = 0
+350    CONTINUE
+
+       yi = yt(it)
+       IF(it.EQ.nmax2)  THEN
+        it       = nmax2 -1
+        Yf(it+1) = pis2
+       ENDIF
+c  .................................................................
+c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
+c      .....           et   Y'(yi)                             .....
+c  .................................................................
+
+       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
+     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
+
+       Yf1     = Yf(it)
+       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
+
+       DO 500 iter = 1,300
+         yi = yi - ( Yf1 - yfi )/ Yprimin
+
+        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
+         yo1      = yi
+         yi2      = yi * yi
+         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
+         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
+500   CONTINUE
+        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
+         STOP 2
+550   CONTINUE
+c
+       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
+       yprim(j)  = pi / ( jjm * Yprimin )
+       yvrai(j)  = yi 
+
+1500    CONTINUE
+
+       DO j = 1, jlat -1
+        IF( yvrai(j+1). LT. yvrai(j) )  THEN
+         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
+     ,  ')'
+         STOP 3
+        ENDIF
+       ENDDO
+
+       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
+     , ,' et  pi/2 '
+c
+        IF( ik.EQ.1 )   THEN
+           ypn = pis2 
+          DO j = jlat,1,-1
+           IF( yvrai(j).LE. ypn ) GO TO 1502
+          ENDDO
+1502     CONTINUE
+
+         jpn   = j
+         y00   = yvrai(jpn)
+         deply = pis2 -  y00
+        ENDIF
+
+         DO  j = 1, jjm +1 - jpn
+           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
+           yprimm(j)  = yprim(jpn+j-1)
+         ENDDO
+
+         jjpn  = jpn
+         IF( jlat.EQ. jjm ) jjpn = jpn -1
+
+         DO j = 1,jjpn 
+          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
+          yprimm(j + jjm+1 -jpn) = yprim(j)
+         ENDDO
+
+c      ***********   Fin de la reorganisation     *************
+c
+ 1600   CONTINUE
+
+       DO j = 1, jlat
+          ylat(j) =  ylatt( jlat +1 -j )
+         yprim(j) = yprimm( jlat +1 -j )
+       ENDDO
+  
+        DO j = 1, jlat
+         yvrai(j) = ylat(j)*180./pi
+        ENDDO
+
+        IF( ik.EQ.1 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatu(j) =  ylat( j )
+           yyprimu(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 2 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*)' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rrlatv(j) =  ylat( j )
+           yyprimv(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 3 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu2(j) =  ylat( j )
+           yprimu2(j) = yprim( j )
+          ENDDO
+
+        ELSE IF ( ik.EQ. 4 )  THEN
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
+c         WRITE(6,68)(yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,68) ( yprim(j),j=1,jlat)
+
+          DO j = 1, jlat
+            rlatu1(j) =  ylat( j )
+           yprimu1(j) = yprim( j )
+          ENDDO
+
+        ENDIF
+
+5000   CONTINUE
+c
+        WRITE(6,18)
+c
+c  .....     fin de la boucle  do 5000 .....
+
+        DO j = 1, jjm
+         ylat(j) = rrlatu(j) - rrlatu(j+1)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO j = 1, jjm
+         champmin = MIN( champmin, ylat(j) )
+         champmax = MAX( champmax, ylat(j) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
+18      FORMAT(/)
+68      FORMAT(1x,7f9.2)
+
+        RETURN
+        END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gcm.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gcm.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gcm.F	(revision 46)
@@ -0,0 +1,599 @@
+      PROGRAM gcm
+
+      IMPLICIT NONE
+
+c      ......   Version  du 10/01/98    ..........
+
+c             avec  coordonnees  verticales hybrides 
+c   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   GCM LMD nouvelle grille
+c
+c=======================================================================
+c
+c  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
+c      et possibilite d'appeler une fonction f(y)  a derivee tangente
+c      hyperbolique a la  place de la fonction a derivee sinusoidale.
+
+c  ... Possibilite de choisir le shema de Van-leer pour l'advection de
+c        q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
+c
+c      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "tracstoke.h"
+#include "sponge.h"
+#include"advtrac.h"
+
+      INTEGER*4  iday ! jour julien
+      REAL       time ! Heure de la journee en fraction d''1 jour
+      REAL zdtvr
+
+c   variables dynamiques
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      real, dimension(ip1jmp1,llm) :: teta   ! temperature potentielle 
+      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL pext(ip1jmp1)                     ! pression  extensive
+      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+      REAL pks(ip1jmp1)                      ! exner au  sol
+      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+      REAL masse(ip1jmp1,llm)                ! masse d''air
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL phi(ip1jmp1,llm)                  ! geopotentiel
+      REAL w(ip1jmp1,llm)                    ! vitesse verticale
+
+c variables dynamiques intermediaire pour le transport
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) !flux de masse
+
+c   variables dynamiques au pas -1
+      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
+
+      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1)
+      REAL massem1(ip1jmp1,llm)
+
+c   tendances dynamiques
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
+
+c   tendances de la dissipation
+      REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm)
+      REAL dhdis(ip1jmp1,llm)
+
+c   tendances physiques
+      REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
+      REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
+
+c   variables pour le fichier histoire
+      REAL dtav      ! intervalle de temps elementaire
+
+      REAL tppn(iim),tpps(iim),tpn,tps
+c
+!      INTEGER iadv(nqmx) ! indice schema de transport pour le traceur iq
+
+      INTEGER itau,itaufinp1,iav
+
+
+      EXTERNAL caldyn, traceur
+      EXTERNAL dissip,geopot,iniconst,inifilr
+      EXTERNAL integrd,SCOPY
+      EXTERNAL inigeom
+      EXTERNAL exner_hyb,addit
+      EXTERNAL defrun_new, test_period
+      REAL  SSUM
+      REAL time_0 , finvmaold(ip1jmp1,llm)
+
+      LOGICAL lafin
+      INTEGER ij,iq,l,ierr,numvanle,iapp_tracvl
+
+      REAL rdayvrai,rdaym_ini,rday_ecri
+!      LOGICAL first
+      REAL beta(ip1jmp1,llm)
+
+      LOGICAL offline  ! Controle du stockage ds "fluxmass"
+      PARAMETER (offline=.false.)
+
+      character*20 modname
+      character*80 abort_message
+
+      LOGICAL tracer
+	  data tracer/.true./
+      INTEGER nq
+
+C Calendrier
+      LOGICAL true_calendar
+      PARAMETER (true_calendar = .false.)
+
+! flag to set/remove calls to groupeun
+      logical callgroupeun
+      parameter (callgroupeun = .true.)
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      modname = 'gcm'
+      descript = 'Run GCM LMDZ'
+      lafin    = .FALSE.
+
+c-----------------------------------------------------------------------
+c  Initialize tracers using iniadvtrac (Ehouarn, oct 2008)
+      CALL iniadvtrac(nq,numvanle)
+
+      CALL dynetat0("start.nc",nqmx,vcov,ucov,
+     .              teta,q,masse,ps,phis, time_0)
+
+      CALL defrun_new( 99, .TRUE. )
+
+
+c  on recalcule eventuellement le pas de temps
+
+      IF(MOD(day_step,iperiod).NE.0)
+     * STOP'Il faut choisir un nb de pas par jour multiple de iperiod'
+
+      IF(MOD(day_step,iphysiq).NE.0)
+     * STOP'Il faut choisir un nb de pas par jour multiple de iphysiq'
+
+      zdtvr    = daysec/FLOAT(day_step)
+        IF(dtvr.NE.zdtvr) THEN
+         PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
+        ENDIF
+
+c  nombre d'etats dans les fichiers demarrage et histoire
+
+      dtvr = zdtvr
+      CALL iniconst
+      CALL inigeom
+
+      CALL inifilr
+
+c
+c   ......    P.Le Van    ( modif  le 29/04/97 )   .........  
+c
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh   ,
+     *                tetagdiv, tetagrot , tetatemp              )
+c
+
+      CALL pression ( ip1jmp1, ap, bp, ps, p       )
+
+      call dump2d(iip1,jjp1,ps,'PRESSION SURFACE')
+      CALL exner_hyb( ip1jmp1, ps, p,beta, pks, pk, pkf )
+
+c
+c  numero de stockage pour les fichiers de redemarrage:
+
+c-----------------------------------------------------------------------
+c   temps de depart et de fin:
+c   --------------------------
+
+      itau = 0
+      iday = day_ini+itau/day_step
+      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+         IF(time.GT.1.) THEN
+          time = time-1.
+          iday = iday+1
+         ENDIF
+      itaufin   = nday*day_step
+c ********************************
+c      itaufin = 120   ! temporaire !!
+c ********************************
+      itaufinp1 = itaufin +1
+
+      day_end = day_ini + nday
+      PRINT 300, itau,itaufin,day_ini,day_end
+ 300  FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,  
+     . 'c''est a dire du jour',i7,3x,'au jour',i7//)
+
+      CALL dynredem0("restart.nc",day_end,anne_ini,phis,nqmx)
+
+      ecripar = .TRUE.
+
+      dtav = iperiod*dtvr/daysec
+
+
+c   Quelques initialisations pour les traceurs
+      call initial0(ijp1llm*nqmx,dq)
+c     istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
+c     istphy=istdyn/iphysiq
+
+      write(*,*) "gcm: callgroupeun set to:",callgroupeun
+c-----------------------------------------------------------------------
+c   Debut de l'integration temporelle:
+c   ----------------------------------
+
+   1  CONTINUE
+c
+      IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
+        CALL test_period ( ucov,vcov,teta,q,p,phis )
+        PRINT *,' ----   Test_period apres continue   OK ! -----', itau
+      ENDIF 
+
+      if (callgroupeun) then
+        call groupeun(jjp1,llm,ucov,.true.)
+        call groupeun(jjm,llm,vcov,.true.)
+        call groupeun(jjp1,llm,teta,.true.)
+        call groupeun(jjp1,llm,masse,.true.)
+        call groupeun(jjp1,1,ps,.false.)
+      endif
+
+      CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
+      CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
+      CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
+      CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
+      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
+
+      forward = .TRUE.
+      leapf   = .FALSE.
+      dt      =  dtvr
+
+c   ...    P.Le Van .26/04/94  ....
+
+      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
+      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
+
+
+   2  CONTINUE
+
+c-----------------------------------------------------------------------
+
+c   date:
+c   -----
+
+!      write(*,*) 'GCM: itau=',itau
+
+c   gestion des appels de la physique et des dissipations:
+c   ------------------------------------------------------
+c
+c   ...    P.Le Van  ( 6/02/95 )  ....
+
+      apphys = .FALSE.
+      statcl = .FALSE.
+      conser = .FALSE.
+      apdiss = .FALSE.
+
+      IF( purmats ) THEN
+         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
+         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
+         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
+     $                              .AND.   physic    ) apphys = .TRUE.
+      ELSE
+         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
+         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
+         IF( MOD(itau+1,iphysiq).EQ.0. AND. physic    ) apphys = .TRUE.
+      END IF
+
+c-----------------------------------------------------------------------
+c   calcul des tendances dynamiques:
+c   --------------------------------
+
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+c
+c
+      CALL caldyn 
+     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
+
+
+c-----------------------------------------------------------------------
+c   calcul des tendances advection des traceurs (dont l'humidite)
+c   -------------------------------------------------------------
+
+      if (tracer) then
+       IF( forward. OR . leapf )  THEN
+
+        DO iq = 1, nqmx
+c
+         IF ( iadv(iq).EQ.1.OR.iadv(iq).EQ.2 )  THEN
+            CALL traceur( iq,iadv,q,teta,pk,w, pbaru, pbarv, dq )
+
+         ELSE IF( iq.EQ. nqmx )   THEN
+c
+            iapp_tracvl = 5
+c
+cccc     iapp_tracvl est la frequence en pas du groupement des flux
+cccc      de masse pour  Van-Leer dans la routine  tracvl  .
+c
+
+            CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
+     *                      p, masse, dq,  iadv(1), teta, pk     )
+
+c
+c                   ...  Modif  F.Codron  ....
+c
+         ENDIF
+c
+        ENDDO
+C
+c        IF (offline) THEN
+C maf stokage du flux de masse pour traceurs OFF-LINE
+
+c           CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+c    .   time_step, itau)
+
+c        ENDIF
+c
+      ENDIF
+	  END IF   ! tracer
+
+
+c-----------------------------------------------------------------------
+c   integrations dynamique et traceurs:
+c   ----------------------------------
+
+       CALL integrd ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 , 
+     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
+     $              finvmaold )
+
+c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
+c
+c-----------------------------------------------------------------------
+c   calcul des tendances physiques:
+c   -------------------------------
+c    ########   P.Le Van ( Modif le  6/02/95 )   ###########
+c
+       IF( purmats )  THEN
+          IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
+       ELSE
+          IF( itau+1. EQ. itaufin )              lafin = .TRUE.
+       ENDIF
+c
+c
+       IF( apphys )  THEN
+c
+c     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
+c
+
+         CALL pression (  ip1jmp1, ap, bp, ps,  p      )
+         CALL exner_hyb(  ip1jmp1, ps, p,beta,pks, pk, pkf )
+
+           rdaym_ini  = itau * dtvr / daysec
+           rdayvrai   = rdaym_ini  + day_ini
+
+           IF ( ecritphy.LT.1. )  THEN
+             rday_ecri = rdaym_ini
+           ELSE
+             rday_ecri = INT( rdayvrai )
+           ENDIF
+c
+        CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time  ,
+     $                 ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
+     $     du,dv,dteta,dq,w, dufi,dvfi,dhfi,dqfi,dpfi,tracer)
+
+
+c      ajout des tendances physiques:
+c      ------------------------------
+          CALL addfi( nqmx, dtphys, leapf, forward   ,
+     $                  ucov, vcov, teta , q   ,ps , masse,
+     $                 dufi, dvfi, dhfi , dqfi ,dpfi  )
+c
+       ENDIF
+
+       CALL pression ( ip1jmp1, ap, bp, ps, p                  )
+
+       CALL exner_hyb( ip1jmp1, ps, p,beta, pks, pk, pkf )
+c   ----------------------------------------------------------
+
+c
+c
+c   dissipation horizontale et verticale  des petites echelles:
+c   ----------------------------------------------------------
+
+
+      IF(apdiss) THEN
+
+c        Sponge layer
+c        ~~~~~~~~~~~~
+         DO ij=1, ip1jmp1
+            pext(ij)=ps(ij)*aire(ij)
+         ENDDO
+         IF (callsponge) THEN
+            CALL sponge(ucov,vcov,teta,pext,dtdiss,mode_sponge)
+         ENDIF
+
+c        Dissipation horizontale
+c        ~~~~~~~~~~~~~~~~~~~~~~~
+         CALL dissip(vcov,ucov,teta,p,dvdis,dudis,dhdis)
+
+         CALL addit( ijp1llm,ucov ,dudis,ucov )
+         CALL addit( ijmllm ,vcov ,dvdis,vcov )
+         CALL addit( ijp1llm,teta ,dhdis,teta )
+
+
+c    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
+c   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
+c
+
+        DO l  =  1, llm
+          DO ij =  1,iim
+           tppn(ij)  = aire(  ij    ) * teta(  ij    ,l)
+           tpps(ij)  = aire(ij+ip1jm) * teta(ij+ip1jm,l)
+          ENDDO
+
+           tpn  = SSUM(iim,tppn,1)/apoln
+           tps  = SSUM(iim,tpps,1)/apols
+
+          DO ij = 1, iip1
+           teta(  ij    ,l) = tpn
+           teta(ij+ip1jm,l) = tps
+          ENDDO
+        ENDDO
+
+        DO ij =  1,iim
+          tppn(ij)  = aire(  ij    ) * ps (  ij    )
+          tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
+        ENDDO
+          tpn  = SSUM(iim,tppn,1)/apoln
+
+          tps  = SSUM(iim,tpps,1)/apols
+
+        DO ij = 1, iip1
+          ps(  ij    ) = tpn
+          ps(ij+ip1jm) = tps
+        ENDDO
+
+
+      END IF
+        
+c   ********************************************************************
+c   ********************************************************************
+c   .... fin de l'integration dynamique  et physique pour le pas itau ..
+c   ********************************************************************
+c   ********************************************************************
+
+c   preparation du pas d'integration suivant  ......
+
+      IF ( .NOT.purmats ) THEN
+c       ........................................................
+c       ..............  schema matsuno + leapfrog  ..............
+c       ........................................................
+
+            IF(forward. OR. leapf) THEN
+              itau= itau + 1
+              iday= day_ini+itau/day_step
+              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+                IF(time.GT.1.) THEN
+                  time = time-1.
+                  iday = iday+1
+                ENDIF
+            ENDIF
+
+
+            IF( itau. EQ. itaufinp1 ) then  
+              abort_message = 'Simulation finished'
+              call abort_gcm(modname,abort_message,0)
+            ENDIF
+c-----------------------------------------------------------------------
+c   ecriture du fichier histoire moyenne:
+c   -------------------------------------
+
+c           IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
+c              IF(itau.EQ.itaufin) THEN
+c                 iav=1
+c              ELSE
+c                 iav=0
+c              ENDIF
+c              CALL writedynav(histaveid, nqmx, itau,vcov ,
+c    ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+c           ENDIF
+
+c-----------------------------------------------------------------------
+
+
+            IF(itau.EQ.itaufin) THEN
+
+
+       PRINT *,' Appel test_period avant redem ', itau
+       CALL test_period ( ucov,vcov,teta,q,p,phis )
+       CALL dynredem1("restart.nc",0.0,
+     .                     vcov,ucov,teta,q,nqmx,masse,ps)
+
+              CLOSE(99)
+            ENDIF
+
+c-----------------------------------------------------------------------
+c   gestion de l'integration temporelle:
+c   ------------------------------------
+
+            IF( MOD(itau,iperiod).EQ.0 )    THEN
+                    GO TO 1
+            ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN
+
+                   IF( forward )  THEN
+c      fin du pas forward et debut du pas backward
+
+                      forward = .FALSE.
+                        leapf = .FALSE.
+                           GO TO 2
+
+                   ELSE
+c      fin du pas backward et debut du premier pas leapfrog
+
+                        leapf =  .TRUE.
+                        dt  =  2.*dtvr
+                        GO TO 2
+                   END IF
+            ELSE
+
+c      ......   pas leapfrog  .....
+
+                 leapf = .TRUE.
+                 dt  = 2.*dtvr
+                 GO TO 2
+            END IF
+
+      ELSE
+
+c       ........................................................
+c       ..............       schema  matsuno        ...............
+c       ........................................................
+            IF( forward )  THEN
+
+             itau =  itau + 1
+             iday = day_ini+itau/day_step
+             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+
+                  IF(time.GT.1.) THEN
+                   time = time-1.
+                   iday = iday+1
+                  ENDIF
+
+               forward =  .FALSE.
+               IF( itau. EQ. itaufinp1 ) then  
+                 abort_message = 'Simulation finished'
+                 call abort_gcm(modname,abort_message,0)
+               ENDIF
+               GO TO 2
+
+            ELSE
+
+            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
+               IF(itau.EQ.itaufin) THEN
+                  iav=1
+               ELSE
+                  iav=0
+               ENDIF
+c              CALL writedynav(histaveid, nqmx, itau,vcov ,
+c    ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+
+            ENDIF
+
+
+                 IF(itau.EQ.itaufin)
+     . CALL dynredem1("restart.nc",0.0,
+     .                     vcov,ucov,teta,q,nqmx,masse,ps)
+
+                 forward = .TRUE.
+                 GO TO  1
+
+
+            ENDIF
+
+      END IF
+
+      STOP
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/geopot.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/geopot.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/geopot.F	(revision 46)
@@ -0,0 +1,69 @@
+      SUBROUTINE geopot (ngrid, teta, pk, pks, phis, phi )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c    ....   calcul du geopotentiel aux milieux des couches    .....
+c    *******************************************************************
+c
+c     ....   l'integration se fait de bas en haut  ....
+c
+c     .. ngrid,teta,pk,pks,phis sont des argum. d'entree pour le s-pg ..
+c              phi               est un  argum. de sortie pour le s-pg .
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid
+      REAL teta(ngrid,llm),pks(ngrid),phis(ngrid),pk(ngrid,llm) ,
+     *       phi(ngrid,llm)
+      real zz(ngrid)
+
+
+c   Local:
+c   ------
+
+      INTEGER  l, ij, count
+      logical flag 
+
+
+c-----------------------------------------------------------------------
+c     calcul de phi au niveau 1 pres du sol  .....
+
+      flag=.false.
+      count=0
+c     call dump2d(iip1,jjp1,teta(:,1),'TETA COUCHE 1')
+c     zz(:)=pks(:)-pk(:,1)
+c     call dump2d(iip1,jjp1,zz(:),'DPK SURF-1')
+
+      DO   ij  = 1, ngrid
+          phi( ij,1 ) = phis( ij ) + teta(ij,1) * ( pks(ij) - pk(ij,1) )
+      ENDDO
+
+c     calcul de phi aux niveaux superieurs  .......
+
+      DO  l = 2,llm
+        DO  ij    = 1,ngrid
+        phi(ij,l) = phi(ij,l-1) + 0.5 * ( teta(ij,l)  + teta(ij,l-1) ) 
+     *                              *   (  pk(ij,l-1) -  pk(ij,l)    )
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_dyn_fi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_dyn_fi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_dyn_fi.F	(revision 46)
@@ -0,0 +1,37 @@
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_fi_dyn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_fi_dyn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_fi_dyn.F	(revision 46)
@@ -0,0 +1,38 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_int_dyn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_int_dyn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_int_dyn.F	(revision 46)
@@ -0,0 +1,46 @@
+      subroutine gr_int_dyn(champin,champdyn,iim,jp1)
+      implicit none
+c=======================================================================
+c   passage d'un champ interpole a un champ sur grille scalaire
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER iim
+      integer ip1, jp1
+      REAL champin(iim, jp1)
+      REAL champdyn(iim+1, jp1)
+
+      INTEGER i, j
+      real polenord, polesud
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      ip1 = iim + 1
+      polenord = 0.
+      polesud = 0.
+      do i = 1, iim
+        polenord = polenord + champin (i, 1)
+        polesud = polesud + champin (i, jp1)
+      enddo
+      polenord = polenord / iim
+      polesud = polesud / iim
+      do j = 1, jp1
+        do i = 1, iim
+          if (j .eq. 1) then
+            champdyn(i, j) = polenord
+          else if (j .eq. jp1) then
+            champdyn(i, j) = polesud
+          else
+            champdyn(i, j) = champin (i, j)
+          endif
+        enddo
+        champdyn(ip1, j) = champdyn(1, j)
+      enddo
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_u_scal.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_u_scal.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_u_scal.F	(revision 46)
@@ -0,0 +1,57 @@
+      SUBROUTINE gr_u_scal(nx,x_u,x_scal)
+c%W%    %G%
+c=======================================================================
+c
+c   Author:    Frederic Hourdin      original: 11/11/92
+c   -------
+c
+c   Subject:
+c   ------
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nx
+      REAL x_u(ip1jmp1,nx),x_scal(ip1jmp1,nx)
+
+c   Local:
+c   ------
+
+      INTEGER l,ij
+
+c-----------------------------------------------------------------------
+
+      DO l=1,nx
+         DO ij=ip1jmp1,2,-1
+            x_scal(ij,l)=
+     s      (aireu(ij)*x_u(ij,l)+aireu(ij-1)*x_u(ij-1,l))
+     s      /(aireu(ij)+aireu(ij-1))
+         ENDDO
+      ENDDO
+
+      CALL SCOPY(nx*jjp1,x_scal(iip1,1),iip1,x_scal(1,1),iip1)
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_v_scal.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_v_scal.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gr_v_scal.F	(revision 46)
@@ -0,0 +1,61 @@
+      SUBROUTINE gr_v_scal(nx,x_v,x_scal)
+c%W%    %G%
+c=======================================================================
+c
+c   Author:    Frederic Hourdin      original: 11/11/92
+c   -------
+c
+c   Subject:
+c   ------
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nx
+      REAL x_v(ip1jm,nx),x_scal(ip1jmp1,nx)
+
+c   Local:
+c   ------
+
+      INTEGER l,ij
+
+c-----------------------------------------------------------------------
+
+      DO l=1,nx
+         DO ij=iip2,ip1jm
+            x_scal(ij,l)=
+     s      (airev(ij-iip1)*x_v(ij-iip1,l)+airev(ij)*x_v(ij,l))
+     s      /(airev(ij-iip1)+airev(ij))
+         ENDDO
+         DO ij=1,iip1
+            x_scal(ij,l)=0.
+         ENDDO
+         DO ij=ip1jm+1,ip1jmp1
+            x_scal(ij,l)=0.
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grad.F	(revision 46)
@@ -0,0 +1,41 @@
+      SUBROUTINE  grad(klevel, pg,pgx,pgy )
+c
+c      P. Le Van
+c
+c    ******************************************************************
+c     .. calcul des composantes covariantes en x et y du gradient de g
+c
+c    ******************************************************************
+c             pg        est un   argument  d'entree pour le s-prog
+c       pgx  et  pgy    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+      INTEGER klevel
+      REAL  pg( ip1jmp1,klevel )
+      REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )
+      INTEGER  l,ij
+c
+c
+      DO 6 l = 1,klevel
+c
+      DO 2  ij = 1, ip1jmp1 - 1
+      pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
+   2  CONTINUE
+c
+c    .... correction pour  pgx(ip1,j,l)  ....
+c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
+CDIR$ IVDEP
+      DO 3  ij = iip1, ip1jmp1, iip1
+      pgx( ij,l ) = pgx( ij -iim,l )
+   3  CONTINUE
+c
+      DO 4 ij = 1,ip1jm
+      pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
+   4  CONTINUE
+c
+   6  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv.F	(revision 46)
@@ -0,0 +1,56 @@
+      SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy )
+c
+c    Auteur :   P. Le Van
+c
+c   ***************************************************************
+c
+c                                ld
+c       calcul  de  (grad (div) )   du vect. v ....
+c
+c     xcov et ycov etant les composant.covariantes de v
+c   ****************************************************************
+c    xcov , ycov et ld  sont des arguments  d'entree pour le s-prog
+c     gdx   et  gdy     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "logic.h"
+
+      INTEGER klevel
+c
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL gdx( ip1jmp1,klevel ),   gdy( ip1jm,klevel )
+
+      REAL div(ip1jmp1,llm)
+
+      INTEGER l,ij,iter,ld
+c
+      EXTERNAL   SCOPY, diverg,  grad
+      EXTERNAL   filtreg
+c
+c
+      CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
+      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
+c
+      DO 10 iter = 1,ld
+c
+      CALL diverg( klevel,  gdx , gdy, div          )
+      CALL filtreg( div, jjp1, klevel, 2,1, .true.,2 )
+      CALL grad( klevel,  div, gdx, gdy           )
+c
+      DO 5  l = 1, klevel
+      DO 3 ij = 1, ip1jmp1
+      gdx( ij,l ) = - gdx( ij,l ) * cdivu
+   3  CONTINUE
+      DO 4 ij = 1, ip1jm
+      gdy( ij,l ) = - gdy( ij,l ) * cdivu
+   4  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv2.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv2.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/gradiv2.F	(revision 46)
@@ -0,0 +1,77 @@
+      SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
+c
+c     P. Le Van
+c
+c   **********************************************************
+c                                ld
+c       calcul  de  (grad (div) )   du vect. v ....
+c
+c     xcov et ycov etant les composant.covariantes de v
+c   **********************************************************
+c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
+c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comdissipn.h"
+c
+c     ........    variables en arguments      ........
+
+      INTEGER klevel
+      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
+c
+c     ........       variables locales       .........
+c
+      REAL div(ip1jmp1,llm)
+      REAL signe, nugrads
+      INTEGER l,ij,iter,ld
+      
+c    ........................................................
+c
+      EXTERNAL   SCOPY, divergf, grad, laplacien_gam, filtreg
+c
+      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
+      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
+c
+c
+      signe   = (-1.)**ld
+      nugrads = signe * cdivu
+c
+
+
+      CALL divergf( klevel, gdx,   gdy , div )
+
+      IF( ld.GT.1 )   THEN
+
+        CALL laplacien ( klevel, div,  div     )
+
+c    ......  Iteration de l'operateur laplacien_gam   .......
+
+        DO iter = 1, ld -2
+         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
+     *                       unsapolnga1, unsapolsga1,  div, div       )
+        ENDDO
+
+      ENDIF
+
+
+       CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
+       CALL grad  ( klevel,  div,   gdx,  gdy             )
+
+c
+       DO   l = 1, klevel
+         DO  ij = 1, ip1jmp1
+          gdx( ij,l ) = gdx( ij,l ) * nugrads
+         ENDDO
+         DO  ij = 1, ip1jm
+          gdy( ij,l ) = gdy( ij,l ) * nugrads
+         ENDDO
+       ENDDO
+c
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_atob.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_atob.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_atob.F	(revision 46)
@@ -0,0 +1,968 @@
+      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Aucune ponderation est consideree (voir grille_p)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+      REAL distans(2200*1100)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+c Calculer les limites des zones des nouveaux points
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c Determiner la zone sur laquelle chaque ancien point se trouve
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               number(ii,jj) = number(ii,jj) + 1.0
+               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c Si aucun ancien point tombe sur une zone, c'est un probleme
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie)
+c=======================================================================
+c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
+c
+c Methode naive pour transformer un champ d'une grille fine a une
+c grille grossiere. Je considere que les nouveaux points occupent
+c une zone adjacente qui comprend un ou plusieurs anciens points
+c
+c Consideration de la distance des points (voir grille_m)
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        sortie: champ de sortie deja transforme
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(200),d(200)
+      REAL number(400,200)
+      INTEGER indx(400,200), indy(400,200)
+      REAL dist(400,200), distsom(400,200)
+c
+      IF (imar.GT.400 .OR. jmar.GT.200) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
+         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
+         CALL ABORT
+      ENDIF
+c
+c calculer les bords a et b de la nouvelle grille
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+c
+c calculer les bords c et d de la nouvelle grille
+c
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+c
+c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
+c un point de l'ancienne grille est tombe.
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               indx(i,j) = ii
+               indy(i,j) = jj
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c faire une verification
+c
+
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
+            PRINT*, 'Probleme grave,i,j,indx,indy=',
+     .              i,j,indx(i,j),indy(i,j)
+            CALL abort
+         ENDIF
+      ENDDO
+      ENDDO
+
+c
+c calculer la distance des anciens points avec le nouveau point,
+c on prend ensuite une sorte d'inverse pour ponderation.
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         distsom(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
+     .                     +(ydata(j)-y(indy(i,j)))**2 )
+         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
+     .                                  + dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
+      ENDDO
+      ENDDO
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         number(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+      DO i = 1, imdep
+      DO j = 1, jmdep
+         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
+     .                                 + entree(i,j) * dist(i,j)
+         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
+     .                                 + dist(i,j)
+      ENDDO
+      ENDDO
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (number(i,j) .GT. 0.001) THEN
+         sortie(i,j) = sortie(i,j) / number(i,j)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
+     .                    imar, jmar, x, y, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
+c                           un champ indicateur (masque) terre/ocean
+c                           terre:1; ocean:0
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL relief(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL num_tot(2200,1100), num_oce(2200,1100)
+c
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_oce(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
+     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
+              mask(i,j) = 0.
+           ELSE
+              mask(i,j) = 1.
+           ENDIF
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+c
+c
+
+
+      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
+     .                    imar, jmar, x, y, sortie, mask)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
+c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
+c fixe (0.001m).
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL sortie(imar,jmar), mask(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_tot(i,j) = 0.0
+         sortie(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
+              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+       IF (NINT(mask(i,j)).EQ.1) THEN
+         IF (num_tot(i,j) .GT. 0.0) THEN
+            sortie(i,j) = sortie(i,j) / num_tot(i,j)
+            sortie(i,j) = EXP(sortie(i,j))
+         ELSE
+            PRINT*, 'probleme,i,j=', i,j
+ccc            CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         sortie(i,j) = entree(i_proche,j_proche)
+         ENDIF
+       ELSE
+         sortie(i,j) = 0.001
+       ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+
+
+      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
+     .                    imar, jmar, x, y, frac_ice)
+c=======================================================================
+c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
+c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
+c (entre 0 et 1) dans une grille plus grossiere.
+c
+c Methode naive (voir grille_m)
+C=======================================================================
+      IMPLICIT none
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL glace01(imdep,jmdep)
+c
+      INTEGER imar, jmar
+      REAL x(imar),y(jmar)
+      REAL frac_ice(imar,jmar)
+c
+      INTEGER i, j, ii, jj
+      REAL a(400),b(400),c(400),d(400)
+      REAL num_tot(400,400), num_ice(400,400)
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      IF (imar.GT.400 .OR. jmar.GT.400) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+c
+
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         num_ice(i,j) = 0.0
+         num_tot(i,j) = 0.0
+      ENDDO
+      ENDDO
+
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imar
+      DO jj = 1, jmar
+        DO i = 1, imdep
+         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmdep
+          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
+              IF (NINT(glace01(i,j)).EQ.1 ) 
+     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+
+      DO i = 1, imar
+      DO j = 1, jmar
+         IF (num_tot(i,j) .GT. 0.001) THEN
+           IF (num_ice(i,j).GT.0.001) THEN
+            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
+           ELSE
+              frac_ice(i,j) = 0.0
+           ENDIF
+         ELSE
+           PRINT*, 'probleme,i,j=', i,j
+ccc           CALL ABORT
+         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imdep*jmdep,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imdep*jmdep
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imdep + 1
+         i_proche = ij_proche - (j_proche-1)*imdep
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
+            frac_ice(i,j) = 1.0
+         ELSE
+            frac_ice(i,j) = 0.0
+         ENDIF
+         ENDIF
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
+      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
+     .                    immod, jmmod, xmod, ymod, rugs)
+c=======================================================================
+c Calculer la longueur de rugosite liee au relief en utilisant
+c l'ecart-type dans une maille de 1x1
+C=======================================================================
+      IMPLICIT none
+c
+#ifdef CRAY
+      INTEGER ISMIN
+#else
+      REAL zzmin
+#endif
+c
+      REAL amin, AMAX
+c
+      INTEGER imrel, jmrel
+      REAL xrel(imrel),yrel(jmrel)
+      REAL relief(imrel,jmrel)
+c
+      INTEGER immod, jmmod
+      REAL xmod(immod),ymod(jmmod)
+      REAL rugs(immod,jmmod)
+c
+      INTEGER imtmp, jmtmp
+      PARAMETER (imtmp=360,jmtmp=180)
+      REAL xtmp(imtmp), ytmp(jmtmp)
+      REAL*8 cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
+      REAL zzzz
+c
+      INTEGER i, j, ii, jj
+      REAL a(2200),b(2200),c(1100),d(1100)
+      REAL number(2200,1100)
+c
+      REAL distans(400*400)
+      INTEGER i_proche, j_proche, ij_proche
+c
+      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
+         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
+         CALL ABORT
+      ENDIF
+c
+c Calculs intermediares:
+c
+      xtmp(1) = -180.0 + 360.0/FLOAT(imtmp) / 2.0
+      DO i = 2, imtmp
+         xtmp(i) = xtmp(i-1) + 360.0/FLOAT(imtmp)
+      ENDDO
+      DO i = 1, imtmp
+         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+      ytmp(1) = -90.0 + 180.0/FLOAT(jmtmp) / 2.0
+      DO j = 2, jmtmp
+         ytmp(j) = ytmp(j-1) + 180.0/FLOAT(jmtmp)
+      ENDDO
+      DO j = 1, jmtmp
+         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
+      ENDDO
+c
+      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
+      b(1) = (xtmp(1)+xtmp(2))/2.0
+      DO i = 2, imtmp-1
+         a(i) = b(i-1)
+         b(i) = (xtmp(i)+xtmp(i+1))/2.0
+      ENDDO
+      a(imtmp) = b(imtmp-1)
+      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
+
+      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
+      d(1) = (ytmp(1)+ytmp(2))/2.0
+      DO j = 2, jmtmp-1
+         c(j) = d(j-1)
+         d(j) = (ytmp(j)+ytmp(j+1))/2.0
+      ENDDO
+      c(jmtmp) = d(jmtmp-1)
+      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
+
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         number(i,j) = 0.0
+         cham1tmp(i,j) = 0.0
+         cham2tmp(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, imtmp
+      DO jj = 1, jmtmp
+        DO i = 1, imrel
+         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmrel
+          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
+              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
+     .                              + relief(i,j)*relief(i,j)
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, imtmp
+      DO j = 1, jmtmp
+         IF (number(i,j) .GT. 0.001) THEN
+         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
+         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
+         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
+         if (zzzz .lt. 0.0) then
+           if (zzzz .gt. -7.5) then
+             zzzz = 0.0
+             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
+           else
+              stop 'Pb rugsoro, zzzz <-7.5'
+           endif
+         endif
+         cham2tmp(i,j) = SQRT(zzzz)
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+         CALL ABORT
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = cham2tmp(1,1)
+      AMAX = cham2tmp(1,1)
+      DO j = 1, jmtmp
+      DO i = 1, imtmp
+         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
+         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type 1x1:', amin, AMAX
+c
+c
+c
+      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
+      b(1) = (xmod(1)+xmod(2))/2.0
+      DO i = 2, immod-1
+         a(i) = b(i-1)
+         b(i) = (xmod(i)+xmod(i+1))/2.0
+      ENDDO
+      a(immod) = b(immod-1)
+      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
+
+      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
+      d(1) = (ymod(1)+ymod(2))/2.0
+      DO j = 2, jmmod-1
+         c(j) = d(j-1)
+         d(j) = (ymod(j)+ymod(j+1))/2.0
+      ENDDO
+      c(jmmod) = d(jmmod-1)
+      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         number(i,j) = 0.0
+         rugs(i,j) = 0.0
+      ENDDO
+      ENDDO
+c
+c
+c
+c  .....  Modif  P. Le Van ( 23/08/95 )  ....
+
+      DO ii = 1, immod
+      DO jj = 1, jmmod
+        DO i = 1, imtmp
+         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
+     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
+     .           THEN
+          DO j = 1, jmtmp
+          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
+     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
+     .           THEN
+              number(ii,jj) = number(ii,jj) + 1.0
+              rugs(ii,jj) = rugs(ii,jj)
+     .                       + LOG(MAX(0.001,real(cham2tmp(i,j))))
+          ENDIF
+          ENDDO
+         ENDIF
+        ENDDO
+      ENDDO
+      ENDDO
+c
+c
+      DO i = 1, immod
+      DO j = 1, jmmod
+         IF (number(i,j) .GT. 0.001) THEN
+         rugs(i,j) = rugs(i,j) / number(i,j)
+         rugs(i,j) = EXP(rugs(i,j))
+         ELSE
+         PRINT*, 'probleme,i,j=', i,j
+ccc         CALL ABORT
+         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
+#ifdef CRAY
+         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
+#else
+         ij_proche = 1
+         zzmin = distans(ij_proche)
+         DO ii = 2, imtmp*jmtmp
+            IF (distans(ii).LT.zzmin) THEN
+               zzmin = distans(ii)
+               ij_proche = ii
+            ENDIF
+         ENDDO
+#endif
+         j_proche = (ij_proche-1)/imtmp + 1
+         i_proche = ij_proche - (j_proche-1)*imtmp
+         PRINT*, "solution:", ij_proche, i_proche, j_proche
+         rugs(i,j) = LOG(MAX(0.001,real(cham2tmp(i_proche,j_proche))))
+         ENDIF
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Ecart-type du modele:', amin, AMAX
+c
+      DO j = 1, jmmod
+      DO i = 1, immod
+         rugs(i,j) = rugs(i,j) / AMAX * 20.0
+      ENDDO
+      ENDDO
+c
+      amin = rugs(1,1)
+      AMAX = rugs(1,1)
+      DO j = 1, jmmod
+      DO i = 1, immod
+         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
+         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
+      ENDDO
+      ENDDO
+      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
+c
+      RETURN
+      END
+c
+      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+c
+c Auteur: Laurent Li (le 30 decembre 1996)
+c
+c Ce programme calcule la distance minimale (selon le grand cercle)
+c entre deux points sur la terre
+c
+c Input:
+      INTEGER im, jm ! dimensions
+      REAL rf_lon ! longitude du point de reference (degres)
+      REAL rf_lat ! latitude du point de reference (degres)
+      REAL rlon(im), rlat(jm) ! longitude et latitude des points
+c
+c Output:
+      REAL distance(im,jm) ! distances en metre
+c
+      REAL rlon1, rlat1
+      REAL rlon2, rlat2
+      REAL dist
+      REAL pa, pb, p, pi
+c
+      REAL radius
+      PARAMETER (radius=6371229.)
+c
+      pi = 4.0 * ATAN(1.0)
+c
+      DO 9999 j = 1, jm
+      DO 9999 i = 1, im
+c
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
+      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
+      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
+c
+      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
+      dist = radius * dist
+      distance(i,j) = dist
+c
+ 9999 CONTINUE
+c
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro.F	(revision 46)
@@ -0,0 +1,487 @@
+
+      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
+     .             imar, jmar, x, y,
+     .             zphi,zmea,zstd,zsig,zgam,zthe,
+     .             zpic,zval,mask)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Compute the Parameters of the SSO scheme as described in
+c      LOTT & MILLER (1997) and LOTT(1999).
+c      Target points are on a rectangular grid:
+c      iim+1 latitudes including North and South Poles;
+c      jjm+1 longitudes, with periodicity jjm+1=1.
+c      aux poles.  At the poles the fields value is repeated
+c      jjm+1 time.
+c      The parameters a,b,c,d represent the limite of the target
+c      gridpoint region. The means over this region are calculated
+c      from USN data, ponderated by a weight proportional to the 
+c      surface occupated by the data inside the model gridpoint area.
+c      In most circumstances, this weight is the ratio between the
+c      surface of the USN gridpoint area and the surface of the
+c      model gridpoint area. 
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X and Y input field
+c        xdata, ydata: coordinates X and Y input field
+c        zdata: Input field
+c        In this version it is assumed that the entry data come from
+c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X and Y Output field
+c        x, y: ccordinates  X and Y Output field.
+c             zmea:  Mean orographie   
+c             zstd:  Standard deviation
+c             zsig:  Slope
+c             zgam:  Anisotropy
+c             zthe:  Orientation of the small axis
+c             zpic:  Maximum altitude
+c             zval:  Minimum altitude
+C=======================================================================
+      IMPLICIT INTEGER (I,J)
+      IMPLICIT REAL(X,Z) 
+      
+      parameter(iusn=2160,jusn=1080,iext=216)
+#include "dimensions.h"
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2)
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL zdata(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
+
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL weight(iim+1,jjm+1)
+
+C CORRELATIONS OF USN OROGRAPHY GRADIENTS
+
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
+      integer mask(imar+1,jmar)
+      real num_tot(2200,1100),num_lan(2200,1100)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      xpi=acos(-1.)
+      rad    = 6 371 229.
+      zdeltay=2.*xpi/float(jusn)*rad
+
+c
+c  quelques tests de dimensions:
+c    
+c
+      if(iim.ne.imar) STOP 'Problem dim. x'
+      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar or jmar too big', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
+        print *,' imar or jmar bad dimensions:',imar,jmar
+        call abort
+      ENDIF
+
+
+c      print *,'xdata:',xdata
+c      print *,'ydata:',ydata
+c      print *,'x:',x
+c      print *,'y:',y
+c
+C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
+C  BOUNDARIES:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=zdata(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=zdata(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=zdata(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c  
+c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
+C     ( REGULAR GRID)
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar+1) = b(imar)
+      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+
+c
+c  initialisations:
+c
+
+c     write (*,*) "zpic: ",zpic
+
+      DO i = 1, imar+1
+         DO j = 1, jmar
+            weight(i,j) = 0.0
+            zxtzx(i,j)  = 0.0
+            zytzy(i,j)  = 0.0
+            zxtzy(i,j)  = 0.0
+            ztz(i,j)    = 0.0
+            zmea(i,j)   = 0.0
+            zpic(i,j)  = -1.E+10
+            zval(i,j)  = 1.E+10
+         ENDDO
+      ENDDO
+c
+c  COMPUTE SLOPES CORRELATIONS ON USN GRID
+c
+         DO j = 1,jusn+2 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
+         ENDDO
+         ENDDO
+c
+c  SUMMATION OVER GRIDPOINT AREA
+c 
+      zleny=xpi/float(jusn)*rad
+      xincr=xpi/2./float(jusn)
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+       num_tot(ii,jj)=0.
+       num_lan(ii,jj)=0.
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=AMAX1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=AMAX1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            num_tot(ii,jj)=num_tot(ii,jj)+1.0
+            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+c mean
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+c peacks
+            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
+c valleys
+            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
+C  LOTT (1999) SSO SCHEME.
+c
+      zllmmea=0.
+      zllmstd=0.
+      zllmsig=0.
+      zllmgam=0.
+      zllmpic=0.
+      zllmval=0.
+      zllmthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Mask
+           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
+             mask(ii,jj)=1
+           else
+             mask(ii,jj)=0
+           endif
+c  Mean Orography:
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c  Standard deviation:
+           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+         ELSE
+            PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+       ENDDO
+       ENDDO
+
+C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
+
+       DO ii = 1, imar+1
+         zxtzx(ii,1)=zxtzx(ii,2)
+         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
+         zxtzy(ii,1)=zxtzy(ii,2)
+         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
+         zytzy(ii,1)=zytzy(ii,2)
+         zytzy(ii,jmar)=zytzy(ii,jmar-1)
+       ENDDO
+
+C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
+
+C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
+
+       CALL MVA9(zmea,iim+1,jjm+1)
+       CALL MVA9(zstd,iim+1,jjm+1)
+       CALL MVA9(zpic,iim+1,jjm+1)
+       CALL MVA9(zval,iim+1,jjm+1)
+       CALL MVA9(zxtzx,iim+1,jjm+1)
+       CALL MVA9(zxtzy,iim+1,jjm+1)
+       CALL MVA9(zytzy,iim+1,jjm+1)
+
+       DO ii = 1, imar
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c slope: 
+           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
+c isotropy:
+           zgam(ii,jj)=xp/xq*mask(ii,jj)
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
+           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
+           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
+           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
+
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
+      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
+      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
+      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
+      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
+      zminthe=amin1(zthe(ii,jj),zminthe)
+      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
+      zllmval=AMAX1(zval(ii,jj),zllmval)
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zllmmea
+      print *,'  ST. DEV.:',zllmstd
+      print *,'  PENTE:',zllmsig
+      print *,' ANISOTROP:',zllmgam
+      print *,'  ANGLE:',zminthe,zllmthe	
+      print *,'  pic:',zllmpic
+      print *,'  val:',zllmval
+      
+C
+c gamma and theta a 1. and 0. at poles
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
+      zpic(imar+1,jj)=zpic(1,jj)
+      zval(imar+1,jj)=zval(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+      zpicnor=0.0
+      zpicsud=0.0                                   
+      zvalnor=0.0
+      zvalsud=0.0 
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
+      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
+      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
+      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zphi(ii,   1)=zmeanor/zweinor
+      zphi(ii,jmar)=zmeasud/zweisud
+      zpic(ii,   1)=zpicnor/zweinor
+      zpic(ii,jmar)=zpicsud/zweisud
+      zval(ii,   1)=zvalnor/zweinor
+      zval(ii,jmar)=zvalsud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+      RETURN
+      END
+
+      SUBROUTINE MVA9(X,IMAR,JMAR)
+
+C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
+
+      PARAMETER (ISMo=300,JSMo=200)
+      REAL X(IMAR,JMAR),XF(ISMo,JSMo)
+      real weight(-1:1,-1:1)
+
+      if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
+      if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'
+      
+      SUM=0.
+      DO IS=-1,1
+      DO JS=-1,1
+      WEIGHT(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
+      SUM=SUM+WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+
+      DO IS=-1,1
+      DO JS=-1,1
+      WEIGHT(IS,JS)=WEIGHT(IS,JS)/SUM
+      ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+      DO I=2,IMAR-1
+      XF(I,J)=0.
+      DO IS=-1,1
+      DO JS=-1,1
+         XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+      ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+         XF(1,J)=0.
+      IS=IMAR-1
+      DO JS=-1,1 
+         XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHT(-1,JS)
+      ENDDO
+      DO IS=0,1 
+      DO JS=-1,1 
+         XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHT(IS,JS)
+      ENDDO
+      ENDDO
+         XF(IMAR,J)=XF(1,J)
+      ENDDO
+
+      DO I=1,IMAR
+      XF(I,1)=XF(I,2)
+      XF(I,JMAR)=XF(I,JMAR-1)
+      ENDDO
+
+      DO I=1,IMAR
+      DO J=1,JMAR
+         X(I,J)=XF(I,J)
+      ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/grid_noro1.F	(revision 46)
@@ -0,0 +1,423 @@
+      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
+     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Calcul des parametres de l'orographie sous-maille necessaires
+c      au nouveau shema de representation des montagnes meso-echelles
+c      dans le modele.  Les points sont mis sur une grille rectangulaire
+c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
+c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
+c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
+c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
+c      en j=1.  
+c      Les parametres a,b,c,d representent les limites de la region
+c      de point de grille correspondant a un point decrit precedemment.
+c      Les moyennes sur ces regions des valeurs calculees a partir de
+c      l'USN, sont ponderees par un poids, fonction de la surface
+c      occuppe par ces donnees a l'interieure de la grille du modele.
+c      Dans la plupart des cas ce poid est le rapport entre la surface
+c      de la region de point de grille USN et la surface de la region
+c      de point de grille du modele.
+c       
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c        dans ce programme, on assume que les donnees sont les altitudes
+c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        les champs de sorties sont sur une grille physique:
+c             zmea:  orographie moyenne
+c             zstd:  deviation standard de l'orographie sous-maille
+c             zsig:  pente de l'orographie sous-maille 
+c             zgam:  anisotropy de l'orographie sous maille
+c             zthe:  orientation de l'axe oriente dans la direction
+c                    de plus grande pente de l'orographie sous maille
+C=======================================================================
+c     IMPLICIT INTEGER (I,J)
+c     IMPLICIT REAL(X,Z) 
+       implicit none
+       integer iusn,jusn,iext
+       parameter(iusn=360,jusn=180,iext=40)
+c!-*-      include 'param1'
+c!-*-      include 'comcstfi.h'
+#include "dimensions.h"
+#include "comconst.h"
+c!-*-
+c!-*-      parameter(iim=cols,jjm=rows)
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
+
+c   modif declarations pour implicit none
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
+      real zsigsud,zweinor,zweisud
+      real xk,xl,xm,xw,xp,xq
+      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
+      real zbordnor,zbordsud,zbordest,zbordoue,xpi
+      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
+      integer i,j,ii,jj,ideltax,ihalph
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL weight(iim+1,jjm+1)
+      REAL x(imar+1),y(jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+c  quelques constantes:
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      print*,'rad =',rad
+      print*,'Long et lat entree'
+      print*,(x(i),i=1,imar+1)
+      print*,(y(j),j=1,jmar)
+       print*,'Long et lat donnees'
+      print*,(xdata(i),i=1,imdep)
+      print*,(ydata(j),j=1,jmdep)
+
+      xpi=acos(-1.)
+      zdeltay=2.*xpi/float(jusn)*rad
+c
+c  quelques tests de dimensions:
+c    
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
+        print *,' imar ou jmar mal dimensionnes:',imar,jmar
+        call abort
+      ENDIF
+c
+C  Extension de la base de donnee de l'USN pour faciliter
+C  les calculs ulterieurs:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=entree(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=entree(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=entree(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c
+c  Calcul d'une orographie filtree aux hautes latitudes
+c  pour permettre des calculs plus isotropiques sur la pente
+c  des montagnes
+c
+       DO i=1,IUSN+2*iext
+       DO J=1,JUSN+2
+          zusnfi(i,j)=0.0
+       ENDDO
+       ENDDO
+
+      DO j=1,jusn
+            ideltax=1./cos(yusn(j+1))
+            ideltax=min(iusn/2-1,ideltax)
+            IF(MOD(IDELTAX,2).EQ.0)THEN
+              IDELTAX=IDELTAX+1
+            ENDIF
+            IHALPH=(IDELTAX-1)/2 
+c           print *,' ideltax=',ideltax
+         IF(ideltax.eq.1)THEN
+            DO i=1,iusn
+               zusnfi(i+iext,j+1)=entree(i,j)
+            ENDDO   
+         ELSE
+            DO i=1,ihalph
+               DO ii=1,i+ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               DO ii=ihalph-i,0,-1
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
+               ENDDO  
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO   
+            DO i=iusn-ihalph+1,iusn
+               DO ii = i-ihalph,iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO 
+               DO ii = 1,ihalph+i-iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+            DO i=ihalph+1,iusn-ihalph
+               DO ii=-ihalph,ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+         ENDIF
+            DO i=1,iext
+               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
+               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
+            ENDDO
+      ENDDO
+c  
+c Calculer les limites des zones des nouveaux points
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+c
+c      quelques initialisations:
+      print*,'OKM1'
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         weight(i,j) = 0.0
+         zxtzx(i,j) = 0.0
+         zytzy(i,j) = 0.0
+         zxtzy(i,j) = 0.0
+         ztz(i,j) = 0.0
+         zmea(i,j) = 0.0
+         zstd(i,j)=0.0
+      ENDDO
+      ENDDO
+c
+c  calculs des correlations de pentes sur la grille de l'USN.
+c
+         DO j = 2,jusn+1 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
+         ENDDO
+
+         ENDDO
+
+ 
+
+      print*,'OK0'
+c
+c  sommations des differentes quantites definies precedemment
+c  sur une grille du modele.
+c 
+      zleny=xpi/float(jusn)*rad
+      xincr=xpi/2./float(jusn)
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=amax1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=amax1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  calculs des differents parametres necessaires au programme
+c  de parametrisation de l'orographie a l'echelle moyenne:
+c
+      zmaxmea=0.
+      zmaxstd=0.
+      zmaxsig=0.
+      zmaxgam=0.
+      zmaxthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       print*,'OK1'
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c       print*,'ok0'
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Orography moyenne:
+c         print*,'ok1'
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c         print*,'ok2'
+c  Deviation standard:
+           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c          print*,'ok3'
+c pente: 
+           zsig(ii,jj)=sqrt(xq)
+c           zsig(ii,jj)=sqrt(2.*xk)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+c          print*,'ok4'
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+c          print*,'ok1b'
+         ENDIF
+      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
+c         print*,'oka'
+      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
+c         print*,'okb'
+      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
+c         print*,'okc'
+      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
+c         print*,'okd'
+      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
+c         print*,'oke'
+      zminthe=amin1(zthe(ii,jj),zminthe)
+c      print*,'ok5'
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zmaxmea
+	  print *,'  ST. DEV.:',zmaxstd
+      print *,'  PENTE:',zmaxsig
+      print *,' ANISOTROP:',zmaxgam
+      print *,'  ANGLE:',zminthe,zmaxthe	
+      
+C
+c  On passe ce donnees sur la grille dite physique....(?)
+c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
+c  n'ont pas vraiment de sens
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupe.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupe.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupe.F	(revision 46)
@@ -0,0 +1,83 @@
+      subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)
+      implicit none
+
+c   SEE COMMENTS IN groupeun.F
+c
+c   sous-programme servant a fitlrer les champs de flux de masse aux
+c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
+c   et a mesure qu'on se rapproche du pole.
+c
+c   en entree: pext, pbaru et pbarv
+c
+c   en sortie:  pbarum,pbarvm et wm.
+c
+c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
+c   pas besoin de w en entree.
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+#include "comvert.h"
+
+
+      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
+      real pext(iip1,jjp1,llm)
+
+      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
+      real wm(iip1,jjp1,llm)
+
+      real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
+
+      real uu
+
+      integer i,j,l
+
+c   Champs 1D
+
+      call convflu(pbaru,pbarv,llm,zconvm)
+
+c
+      call scopy(ijp1llm,zconvm,1,zconvmm,1)
+      call scopy(ijmllm,pbarv,1,pbarvm,1)
+
+c
+      call groupeun(jjp1,llm,zconvmm)
+      call groupeun(jjm,llm,pbarvm)
+
+c   Champs 3D
+
+      do l=1,llm
+         do j=2,jjm
+            uu=pbaru(iim,j,l)
+            do i=1,iim
+               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
+               pbarum(i,j,l)=uu
+c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
+c    *                      yflu(i,j,l)-yflu(i,j-1,l)
+            enddo
+            pbarum(iip1,j,l)=pbarum(1,j,l)
+         enddo
+      enddo
+
+c    integration de la convergence de masse de haut  en bas ......
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iip1
+               zconvmm(i,j,l)=zconvmm(i,j,l)
+            enddo
+         enddo
+      enddo
+      do  l = llm-1,1,-1
+          do j=1,jjp1
+             do i=1,iip1
+                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
+             enddo
+          enddo
+      enddo
+
+      CALL vitvert(zconvmm,wm)
+
+      return
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupeun.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupeun.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/groupeun.F	(revision 46)
@@ -0,0 +1,145 @@
+!Mars importe directement de la version martienne 
+      subroutine groupeun(jjmax,llmax,q)
+      implicit none
+
+c *********************************************************
+c     lissage fort des champs aux poles pour permettre 
+c     de tourner avec plafond haut.
+c     F. Hourdin, 1997.
+c     (commentaire et test sur ngroup par Francois Forget, 05/2000)
+c
+c     Technique :
+c
+c     1) Les points sont regroupes par paquet de 2**ngroup 
+c     aux poles (e.g. ngroup=3 -> paquet de 8), puis 2**(ngroup-1)
+c     2**(ngroup-2), etc... aux latitude plus basse en s'eloignant du pole
+c
+c     2) Plus ngroup est eleve, plus le lissage est efficace
+c
+c     3) MAIS, il faut iim divisible par 2**ngroup !!!
+c
+c
+c *********************************************************
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+
+      integer jjmax,llmax
+      real q(iip1,jjmax,llmax)
+
+      integer ngroup
+      parameter (ngroup=2) 
+
+      logical intensive
+
+      real airen,airecn,qn
+      real aires,airecs,qs
+
+      integer i,j,l,ig,j1,j2,i0,jd
+      logical firstcall
+      DATA firstcall/.true./
+
+c -------------------------------------------------------
+c   test sur ngroup :
+
+      if (firstcall) then
+        IF(MOD(iim,2**ngroup).NE.0) then
+           write(*,*) 'Problem in groupeun.F'
+           write(*,*) 'iim= ', iim, ' ngroup=', ngroup
+           write(*,*) 'iim must be divisible by par 2**ngroup= ',
+     &                 2**ngroup
+           write(*,*) ' YOU must change ngroup in groupeun.F'
+           write(*,*) ' Have fun... '
+           stop
+        END IF
+        write(*,*) 'in groupeun.F, ngroup=', ngroup
+        firstcall = .false.
+      end if
+      
+
+c Champs 3D
+      intensive=.true.
+      if (intensive) then
+      jd=jjp1-jjmax
+      do l=1,llmax
+       j1=1+jd
+       j2=2
+       do ig=1,ngroup
+         do j=j1-jd,j2-jd
+c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
+            do i0=1,iim,2**(ngroup-ig+1)
+               airen=0.
+               airecn=0.
+               qn=0.
+               aires=0.
+               airecs=0.
+               qs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  airen=airen+aire(i,j)
+                  aires=aires+aire(i,jjp1-j+1)
+                  qn=qn+q(i,j,l)*aire(i,j)
+                  qs=qs+q(i,jjp1-j+1-jd,l)*aire(i,jjp1-j+1)
+               enddo
+               airecn=0.
+               airecs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  q(i,j,l)=qn/airen
+                  q(i,jjp1-j+1-jd,l)=qs/aires
+               enddo
+            enddo
+            q(iip1,j,l)=q(1,j,l)
+            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
+         enddo
+         j1=j2+1
+         j2=j2+2**ig
+       enddo
+      enddo
+
+c  ---------------
+      else
+c   Cas sans multiplication par les aires.
+c  ---------------
+
+      jd=jjp1-jjmax
+      do l=1,llmax
+      j1=1+jd
+      j2=2
+      do ig=1,ngroup
+         do j=j1-jd,j2-jd
+c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
+            do i0=1,iim,2**(ngroup-ig+1)
+               airen=0.
+               airecn=0.
+               qn=0.
+               aires=0.
+               airecs=0.
+               qs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  airen=airen+aire(i,j)
+                  aires=aires+aire(i,jjp1-j+1)
+                  qn=qn+q(i,j,l)
+                  qs=qs+q(i,jjp1-j+1-jd,l)
+               enddo
+               airecn=0.
+               airecs=0.
+               do i=i0,i0+2**(ngroup-ig+1)-1
+                  q(i,j,l)=qn*aire(i,j)/airen
+                  q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
+               enddo
+            enddo
+            q(iip1,j,l)=q(1,j,l)
+            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
+         enddo
+         j1=j2+1
+         j2=j2+2**ig
+      enddo
+      enddo
+
+      endif
+
+c     print*,'On groupe jusque j=',j1-1,rlatu(j1-1)*180./pi
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/heavyside.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/heavyside.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/heavyside.F	(revision 46)
@@ -0,0 +1,21 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/heavyside.F,v 1.2 2001/04/13 15:49:10 lmdz Exp $
+c
+       FUNCTION heavyside(a)
+
+c      ...   P. Le Van  ....
+c
+       IMPLICIT NONE
+
+       REAL*8 heavyside , a
+
+       IF ( a.LE.0. )  THEN
+         heavyside = 0.
+       ELSE
+         heavyside = 1.
+       ENDIF
+
+       RETURN
+       END
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ini_archive.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ini_archive.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ini_archive.F	(revision 46)
@@ -0,0 +1,526 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:  ecriture de l'entete du fichier "start_archive"
+c   -----
+c
+c	 Proche de iniwrite.F
+c
+c	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       ith            soil thermal inertia
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+ 
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "control.h"
+#include"comsoil.h"
+
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL		tab_cntrl(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      real ith(ip1jmp1,nsoilmx)
+      REAL		tab_cntrl_fi(length)
+
+!Mars --------Ajouts-----------
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3) !, dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llmp1,idim_llm
+      INTEGER idim_tim
+      INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID #
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      tab_cntrl(1)  = FLOAT(iim) ! nombre de points en longitude
+      tab_cntrl(2)  = FLOAT(jjm) ! nombre de points en latitude
+      tab_cntrl(3)  = FLOAT(llm) ! nombre de couches
+      tab_cntrl(4)  = FLOAT(idayref) ! jour 0
+      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+      tab_cntrl(8)  = cpp 
+      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+      tab_cntrl(12) = etot0 ! energie totale    !
+      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+      tab_cntrl(16) = ang0 ! moment cinetique  !
+      tab_cntrl(17) = pa
+      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+       tab_cntrl(26) = 0.
+       IF ( ysinus)  tab_cntrl(26) = 1.
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau dynamique
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+l)=tab_cntrl_fi(l)
+      ENDDO
+
+c=======================================================================
+c	Ecriture NetCDF de l''entete du fichier "start_archive"
+c=======================================================================
+
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 21,
+     &                       "Fichier start_archive")
+c
+c Definir les dimensions du fichiers:
+c
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
+
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c  Ecriture du tableau des parametres du run
+c-----------------------------------------------------------------------
+
+      call def_var(nid,"Time","Time","days since 00:00:00",1,
+     .            idim_tim,nvarid,ierr)
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des longitudes et latitudes
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des niveaux verticaux
+c-----------------------------------------------------------------------
+
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Coef A: niveaux pression hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
+     .                       "Coefficient B niveaux sigma hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+c
+c ----------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c--------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+!---------------------
+! soil thermal inertia
+!---------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      dims3(1)=idim_rlonv
+      dims3(2)=idim_rlatu
+      dims3(3)=idim_nsoilmx
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     &                        "Soil thermal inertia")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
+     &                        "J.s-1/2.m-2.K-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture du geopentiel au sol
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
+      PRINT*,'daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniadvtrac.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniadvtrac.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniadvtrac.F	(revision 46)
@@ -0,0 +1,143 @@
+      subroutine iniadvtrac(nq,numvanle)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! routine which initializes tracer names and advection schemes
+! reads these infos from file 'traceur.def' but uses default values
+! if that file is not found.
+! Ehouarn Millour. Oct. 2008  (made this LMDZ4-like) for future compatibility 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "advtrac.h"
+#include "control.h"
+
+! routine arguments:
+      INTEGER,INTENT(out) :: nq ! number of tracers
+      INTEGER,INTENT(out) :: numvanle
+
+! local variables:
+      LOGICAL :: first
+      INTEGER :: iq
+      INTEGER :: ierr
+      CHARACTER(len=3) :: qname
+
+! Look for file traceur.def
+      OPEN(90,file='traceur.def',form='formatted',status='old',
+     &        iostat=ierr)
+      IF (ierr.eq.0) THEN
+        write(*,*) "iniadvtrac: Reading file traceur.def"
+        ! read number of tracers:
+        read(90,*,iostat=ierr) nq
+        if (ierr.ne.0) then
+          write(*,*) "iniadvtrac: 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(*,*) "iniadvtrac: error, wrong number of tracers:"
+            write(*,*) "nq=",nq," whereas nqmx=",nqmx
+            stop
+          endif
+        endif
+        
+        ! initialize advection schemes to Van-Leer for all tracers
+        do iq=1,nq
+          iadv(iq)=3 ! Van-Leer
+        enddo
+        
+        do iq=1,nq
+        ! minimal version, just read in the tracer names, 1 per line
+          read(90,*,iostat=ierr) tnom(iq)
+          if (ierr.ne.0) then
+            write(*,*) 'iniadvtrac: error reading tracer names...'
+            stop
+          endif
+        enddo !of do iq=1,nq
+      ELSE
+        write(*,*) "iniadvtrac: file traceur.def not found !"
+        write(*,*) "            using default names (q01,q02,...)",
+     &             "for tracers"
+        ! build default 'q01','q02',... names
+        DO iq=1,nqmx
+          write(qname,'(a1,i2.2)')'q',iq
+          tnom(iq)=qname
+        ENDDO
+        ! set advection scheme type to Van-Leer
+        DO iq = 1, nqmx
+         iadv( iq ) = 3    ! Van-Leer 
+        ENDDO
+        ! set value of nq to nqmx
+        nq=nqmx
+      ENDIF ! of IF (ierr.eq.0)
+
+c  ....  Choix  des shemas d'advection pour l'eau et les traceurs  ...
+c  ...................................................................
+c
+c     iadv = 1    shema  transport type "humidite specifique LMD"  
+c     iadv = 2    shema   amont
+c     iadv = 3    shema  Van-leer
+c     iadv = 4    schema  Van-leer + humidite specifique
+c                        Modif F.Codron
+c 
+c
+      DO  iq = 1, nqmx-1
+       IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
+     * ,' pour le traceur no ', iq
+       IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema  amont',' pour le'
+
+     * ,' traceur no ', iq
+       IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour'
+     * ,'le traceur no ', iq
+
+       IF( iadv(iq).EQ.4 )  THEN
+         PRINT *,' Le shema  Van-Leer + humidite specifique ',
+     * ' est  uniquement pour la vapeur d eau .'
+         PRINT *,' Corriger iadv( ',iq, ')  et repasser ! '
+         CALL ABORT
+       ENDIF
+
+       IF( iadv(iq).LE.0.OR.iadv(iq).GT.4 )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqmx).Corriger et '
+     * ,' repasser car  iadv(iq) = ', iadv(iq)
+         CALL ABORT
+       ENDIF
+      ENDDO
+
+       IF( iadv(nqmx).EQ.1 ) PRINT *,' Choix du shema humidite '
+     * ,'specifique pour la vapeur d''eau'
+       IF( iadv(nqmx).EQ.2 ) PRINT *,' Choix du shema  amont',' pour la'
+     * ,' vapeur d''eau '
+       IF( iadv(nqmx).EQ.3 ) PRINT *,' Choix du shema  Van-Leer '
+     * ,' pour la vapeur d''eau'
+       IF( iadv(nqmx).EQ.4 ) PRINT *,' Choix du shema  Van-Leer + '
+     * ,' humidite specifique pour la vapeur d''eau'
+c
+       IF( (iadv(nqmx).LE.0).OR.(iadv(nqmx).GT.4) )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqmx).Corriger et '
+     * ,' repasser car  iadv(nqmx) = ', iadv(nqmx)
+         CALL ABORT
+       ENDIF
+
+      first = .TRUE.
+      numvanle = nqmx + 1
+      DO  iq = 1, nqmx
+        IF(((iadv(iq).EQ.3).OR.(iadv(iq).EQ.4)).AND.first ) THEN
+          numvanle = iq
+          first    = .FALSE. 
+        ENDIF
+      ENDDO
+c
+      DO  iq = 1, nqmx
+
+      IF( (iadv(iq).NE.3.AND.iadv(iq).NE.4).AND.iq.GT.numvanle )  THEN
+          PRINT *,' Il y a discontinuite dans le choix du shema de ',
+     *    'Van-leer pour les traceurs . Corriger et repasser . '
+           CALL ABORT
+      ENDIF
+
+      ENDDO
+c
+
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniav.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniav.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniav.F	(revision 46)
@@ -0,0 +1,235 @@
+      SUBROUTINE iniav(fichnom,pday0,pyear0,pfrac0,pperiod,phis,nq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   pday0    jour de reference pour le stockage
+c   pfrac0   decalage du debut du stockage par rapport a pday0 (en jour)
+c   pperiod  period de stockage en secondes
+c   phis     geopotentiel au sol
+c   
+c   initialisation de l'ecriture des moyennes temporelles.
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comav.h"
+#include "netcdf.inc"
+#include "comvert.h"
+#include "comgeom.h"
+
+      REAL pperiod
+
+      INTEGER*4 pday0,pyear0
+      REAL pfrac0
+      CHARACTER*(*) fichnom
+      REAL phis(ip1jmp1)
+c
+      CHARACTER str3*3
+c
+      INTEGER nq
+      INTEGER ierr, nid, nvarid, iq
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_s, idim_sig
+      INTEGER idim_tim
+      INTEGER dims2(2), dims3(3), dims4(4)
+
+      period_av=pperiod
+      time0_av=pfrac0
+c
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
+         WRITE(6,*)' ierr = ', ierr
+         CALL ABORT
+      ENDIF
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 32,
+     .                       "Fichier moyen histoire dynamique")
+c
+c Definir les dimensions du fichiers:
+c
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
+      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
+      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+c
+c Definir et enregistrer certains champs invariants:
+c
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+      ierr = NF_REDEF (nid)
+ccc      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c
+c Geopentiel au sol:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+ccc      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c Definir les variables pour pouvoir les enregistrer plus tard:
+c
+      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
+c
+ccc      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
+      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "iniav: Erreur pour definir <temps>"
+         CALL abort
+      ENDIF
+c
+      dims4(1) = idim_rlonu
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"vitu",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"vitu",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatv
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"vitv",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"vitv",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"temp",NF_DOUBLE,4,dims4,nvarid)
+      ierr = NF_DEF_VAR (nid,"temp",NF_FLOAT,4,dims4,nvarid)
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+      IF(nq.GE.1) THEN
+      DO iq=1,nq
+      IF (iq.GT.99) THEN
+         PRINT*, "Trop de traceurs"
+         CALL abort
+      ELSE
+         str3(1:1)='q'
+         WRITE(str3(2:3),'(i2.2)') iq
+ccc         ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
+         ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
+      ENDIF
+      ENDDO
+      ENDIF
+c
+      dims3(1) = idim_rlonv
+      dims3(2) = idim_rlatu
+      dims3(3) = idim_tim
+ccc      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
+      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+      ierr = NF_CLOSE(nid) ! fermer le fichier
+
+      PRINT*,'le fichier hist.moy stoke les variables toutes'
+      PRINT*,'les ',period_av,'s'
+      PRINT*,'A partir du jour de reference day0'
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniconst.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniconst.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniconst.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE iniconst
+
+      IMPLICIT NONE
+c
+c      P. Le Van
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "temps.h"
+#include "control.h"
+#include "comvert.h"
+
+
+      INTEGER :: l
+c
+c
+      EXTERNAL disvert
+c
+c-----------------------------------------------------------------------
+c   dimension des boucles:
+c   ----------------------
+
+      im      = iim
+      jm      = jjm
+      lllm    = llm
+      imp1    = iim 
+      jmp1    = jjm + 1
+      lllmm1  = llm - 1
+      lllmp1  = llm + 1
+
+c-----------------------------------------------------------------------
+
+      dtdiss  = idissip * dtvr
+      dtphys  = iphysiq * dtvr
+      unsim   = 1./iim
+      pi      = 2.*ASIN( 1. )
+
+c-----------------------------------------------------------------------
+c
+
+      r       = cpp * kappa
+
+      PRINT*,' R  CPP  Kappa ',  r , cpp,  kappa
+c
+c-----------------------------------------------------------------------
+      CALL disvert
+c
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inidissip.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inidissip.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inidissip.F	(revision 46)
@@ -0,0 +1,287 @@
+      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
+     *                       tetagdiv,tetagrot,tetatemp             )
+c=======================================================================
+c   initialisation de la dissipation horizontale
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "control.h"
+
+      LOGICAL lstardis
+      INTEGER nitergdiv,nitergrot,niterh
+      REAL    tetagdiv,tetagrot,tetatemp
+      REAL zvert(llm),zz
+      REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
+      REAL ullm,vllm,umin,vmin,zhmin,zhmax
+      REAL zllm,z1llm
+
+      INTEGER l,ij,idum,ii
+      REAL tetamin
+
+      EXTERNAL ran1
+      REAL ran1
+      real sig_s(llm)
+      save sig_s
+      logical firstcall
+      data firstcall/.true./
+      save firstcall 
+
+      REAL fac_mid
+      REAL fac_up
+      REAL delta
+      REAL middle,startalt
+      SAVE fac_mid, fac_up, delta, startalt, middle
+
+c ------------------------------------------------------
+      if (firstcall) then
+         firstcall=.false.
+         do l=1,llm
+            sig_s(l)=aps(l)/preff + bps(l)
+         enddo
+
+c        COMPUTING THE VARIATION OF DISSIPATION AS A FUNCTION OF MODEL TOP :
+c         FF 2004       
+         if (pseudoalt(llm).lt.160.) then 
+             fac_mid=2  ! coeff  pour dissipation aux basses/moyennes altitudes
+             fac_up=10 ! coeff multiplicateur pour dissipation hautes altitudes
+             startalt=90. ! altitude en Km de la transition mid / up
+             delta=20.! Intervalle (km) pour le changement mid / up
+         else ! thermosphere model
+             fac_mid=2 ! coeff pour dissipation aux basses/moyennes altitudes
+             fac_up=25 ! coeff multiplicateur pour dissipation hautes altitudes
+c            startalt: 95 OK for MY24
+             startalt=95. ! altitude en Km de la transition mid / up
+             delta=30.! Intervalle (km) pour le changement mid /up
+         end if
+         middle=startalt+delta/2
+         write(*,*) 'Dissipation : '
+         write(*,*) 'Multiplication de la dissipation en altitude :',
+     &          ' fac_mid, fac_up =', fac_mid, fac_up 
+         write(*,*) 'Transition mid /up : startalt, delta =',
+     &             startalt, delta , '(km)'
+      endif
+
+c-----------------------------------------------------------------------
+c
+c   calcul des valeurs propres des operateurs par methode iterrative:
+c   -----------------------------------------------------------------
+
+      crot     = -1.
+      cdivu    = -1.
+      cdivh    = -1.
+
+c   calcul de la valeur propre de divgrad:
+c   --------------------------------------
+      idum = 0
+      DO l = 1, llm
+       DO ij = 1, ip1jmp1
+        deltap(ij,l) = 1.
+       ENDDO
+      ENDDO
+
+      idum  = -1
+      zh(1) = RAN1(idum)-.5
+      idum  = 0
+      DO ij = 2, ip1jmp1
+        zh(ij) = RAN1(idum) -.5
+      ENDDO
+
+      CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
+
+      CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
+
+      IF ( zhmin .GE. zhmax  )     THEN
+         PRINT*,'  Inidissip  zh min max  ',zhmin,zhmax
+         STOP'probleme generateur alleatoire dans inidissip'
+      ENDIF
+
+      zllm = ABS( zhmax )
+      DO l = 1,50
+         IF(lstardis) THEN
+            CALL divgrad2(1,zh,deltap,niterh,zh)
+         ELSE
+            CALL divgrad (1,zh,niterh,zh)
+         ENDIF
+
+        CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
+
+         zllm  = ABS( zhmax )
+         z1llm = 1./zllm
+         DO ij = 1,ip1jmp1
+            zh(ij) = zh(ij)* z1llm
+         ENDDO
+      ENDDO
+
+      IF(lstardis) THEN
+         cdivh = 1./ zllm
+      ELSE
+         cdivh = zllm ** ( -1./niterh )
+      ENDIF
+
+c   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
+c   -----------------------------------------------------------------
+      print*,'calcul des valeurs propres'
+
+      DO  20  ii = 1, 2
+c
+         DO ij = 1, ip1jmp1
+           zu(ij)  = RAN1(idum) -.5
+         ENDDO
+         CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
+         DO ij = 1, ip1jm
+            zv(ij) = RAN1(idum) -.5
+         ENDDO
+         CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
+
+         CALL minmax(iip1*jjp1,zu,umin,ullm )
+         CALL minmax(iip1*jjm, zv,vmin,vllm )
+
+         ullm = ABS ( ullm )
+         vllm = ABS ( vllm )
+
+         DO  5  l = 1, 50
+            IF(ii.EQ.1) THEN
+               IF(lstardis) THEN
+                  CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
+               ELSE
+                  CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
+               ENDIF
+            ELSE
+               IF(lstardis) THEN
+                  CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
+               ELSE
+                  CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
+               ENDIF
+            ENDIF
+
+            CALL minmax(iip1*jjp1,zu,umin,ullm )
+            CALL minmax(iip1*jjm, zv,vmin,vllm )
+
+            ullm = ABS  ( ullm )
+            vllm = ABS  ( vllm )
+
+            zllm  = MAX( ullm,vllm )
+            z1llm = 1./ zllm
+            DO ij = 1, ip1jmp1
+              zu(ij) = zu(ij)* z1llm
+            ENDDO
+            DO ij = 1, ip1jm
+               zv(ij) = zv(ij)* z1llm
+            ENDDO
+ 5       CONTINUE
+
+         IF ( ii.EQ.1 ) THEN
+            IF(lstardis) THEN
+               cdivu  = 1./zllm
+            ELSE
+               cdivu  = zllm **( -1./nitergdiv )
+            ENDIF
+         ELSE
+            IF(lstardis) THEN
+               crot   = 1./ zllm
+            ELSE
+               crot   = zllm **( -1./nitergrot )
+            ENDIF
+         ENDIF
+
+ 20   CONTINUE
+
+c   petit test pour les operateurs non star:
+c   ----------------------------------------
+
+c     IF(.NOT.lstardis) THEN
+c        fac_mid    = rad*24./float(jjm)
+c        fac_mid    = fac_mid*fac_mid
+c        PRINT*,'coef u ', fac_mid/cdivu, 1./cdivu
+c        PRINT*,'coef r ', fac_mid/crot , 1./crot
+c        PRINT*,'coef h ', fac_mid/cdivh, 1./cdivh
+c     ENDIF
+
+c-----------------------------------------------------------------------
+c   variation verticale du coefficient de dissipation:
+c   --------------------------------------------------
+
+      DO l=1,llm
+         zvert(l)=1.
+      ENDDO
+
+c
+      DO l = 1, llm
+         zz   = 1. -1./sig_s(l)
+         zvert(l)= fac_mid -( fac_mid-1.)/( 1.+zz*zz )
+
+c ---------------------------------------------------------------
+c Utilisation de la fonction tangente hyperbolique pour augmenter
+c arbitrairement la dissipation et donc la stabilite du modele a 
+c partir d'une certaine altitude.
+
+c   Le facteur multiplicatif de basse atmosphere etant deja pris 
+c   en compte, il faut diviser le facteur multiplicatif de haute 
+c   atmosphere par celui-ci.
+c   ============================================================
+
+         zvert(l)= zvert(l)*(1.0+((fac_up/fac_mid-1)
+     &   *(1-(0.5*(1+tanh(-6./delta*    
+     &   (10.*(-log(sig_s(l)))-middle)))))
+     &   ))
+      ENDDO
+ 
+c -----------------------------------------------------------------------------
+
+c
+
+      PRINT*,'Constantes de temps de la diffusion horizontale'
+
+      tetamin =  1.e+6
+
+
+      DO l=1,llm
+        tetaudiv(l)   = zvert(l)/tetagdiv
+        tetaurot(l)   = zvert(l)/tetagrot
+        tetah(l)      = zvert(l)/tetatemp
+
+        IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
+        IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
+        IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
+      ENDDO
+
+c     Calcul automatique de idissip
+c     -----------------------------
+c    :::::::::::::::::::::
+c     A Commenter pour garder la valeur de run.def :
+c     idissip = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
+c     idissip = MAX(iperiod,idissip)
+c    :::::::::::::::::::::
+      dtdiss  = idissip * dtvr
+ 
+      PRINT *,' INIDI tetamin dtvr ',tetamin,dtvr,iperiod
+      PRINT *,' INIDI tetamin idissip ',tetamin,idissip
+      PRINT *,' INIDI idissip dtdiss ',idissip,dtdiss
+
+      PRINT*,'pseudoZ(km)  zvert  dt(tetagdiv) dt(tetagrot) dt(divgrad)'
+      DO l = 1,llm
+         PRINT*,pseudoalt(l),zvert(l),dtdiss*tetaudiv(l),
+     *        dtdiss*tetaurot(l),dtdiss*tetah(l)
+         if ( (dtdiss*tetaudiv(l).gt.1.9).or.
+     &        (dtdiss*tetaurot(l).gt.1.9).or.
+     &        (dtdiss*tetah(l).gt.1.9)) then
+          PRINT *,'STOP : your dissipation is too intense for the '      
+          PRINT *,'dissipation timestep : unstable model !'
+          PRINT *,'in run.def, you must increase tetagdiv,' 
+          PRINT *,'(or tetagrot and tetatemp if they are smaller than'
+          PRINT *,'tetagdiv) OR decrease idissip OR increase day_step)' 
+          stop
+         end if
+  
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigeom.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigeom.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigeom.F	(revision 46)
@@ -0,0 +1,699 @@
+c
+c $Header: /users/lmdz/cvsroot/LMDZ.3.3/libf/dyn3d/inigeom.F,v 1.3 2001/04/13 15:49:10 lmdz Exp $
+c
+      SUBROUTINE inigeom
+c
+c     Auteur :  P. Le Van
+c
+c   ............      Version  du 01/04/2001     ........................
+c
+c  Calcul des elongations cuij1,.cuij4 , cvij1,..cvij4  aux memes en-
+c     endroits que les aires aireij1,..aireij4 .
+
+c  Choix entre f(y) a derivee sinusoid. ou a derivee tangente hyperbol.
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom2.h"
+#include "serre.h"
+#include "logic.h"
+#include "comdissnew.h"
+
+c-----------------------------------------------------------------------
+c   ....  Variables  locales   ....
+c
+      INTEGER  i,j,itmax,itmay,iter
+      REAL cvu(iip1,jjp1),cuv(iip1,jjm)
+      REAL ai14,ai23,airez,rlatp,rlatm,xprm,xprp,un4rad2,yprp,yprm
+      REAL eps,x1,xo1,f,df,xdm,y1,yo1,ydm
+      REAL coslatm,coslatp,radclatm,radclatp
+      REAL cuij1(iip1,jjp1),cuij2(iip1,jjp1),cuij3(iip1,jjp1),
+     *     cuij4(iip1,jjp1)
+      REAL cvij1(iip1,jjp1),cvij2(iip1,jjp1),cvij3(iip1,jjp1),
+     *     cvij4(iip1,jjp1)
+      REAL rlonvv(iip1),rlatuu(jjp1)
+      REAL rlatu1(jjm),yprimu1(jjm),rlatu2(jjm),yprimu2(jjm) ,
+     *     yprimv(jjm),yprimu(jjp1)
+      REAL gamdi_gdiv, gamdi_grot, gamdi_h
+ 
+      REAL rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),
+     ,  xprimp025(iip1)
+      SAVE rlatu1,yprimu1,rlatu2,yprimu2,yprimv,yprimu
+      SAVE rlonm025,xprimm025,rlonp025,xprimp025
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+c
+c
+c   ------------------------------------------------------------------
+c   -                                                                -
+c   -    calcul des coeff. ( cu, cv , 1./cu**2,  1./cv**2  )         -
+c   -                                                                -
+c   ------------------------------------------------------------------
+c
+c      les coef. ( cu, cv ) permettent de passer des vitesses naturelles
+c      aux vitesses covariantes et contravariantes , ou vice-versa ...
+c
+c
+c     on a :  u (covariant) = cu * u (naturel)   , u(contrav)= u(nat)/cu
+c             v (covariant) = cv * v (naturel)   , v(contrav)= v(nat)/cv
+c
+c       on en tire :  u(covariant) = cu * cu * u(contravariant)
+c                     v(covariant) = cv * cv * v(contravariant)
+c
+c
+c     on a l'application (  x(X) , y(Y) )   avec - im/2 +1 <  X  < im/2
+c                                                          =     =
+c                                           et   - jm/2    <  Y  < jm/2
+c                                                          =     =
+c
+c      ...................................................
+c      ...................................................
+c      .  x  est la longitude du point  en radians       .
+c      .  y  est la  latitude du point  en radians       .
+c      .                                                 .
+c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
+c      .          cv( j ) = rad          * dy/dY         .
+c      .        aire(i,j) =  cu(i,j) * cv(j)             .
+c      .                                                 .
+c      . y, dx/dX, dy/dY calcules aux points concernes   .
+c      .                                                 .
+c      ...................................................
+c      ...................................................
+c
+c
+c
+c                                                           ,
+c    cv , bien que dependant de j uniquement,sera ici indice aussi en i
+c          pour un adressage plus facile en  ij  .
+c
+c
+c
+c  **************  aux points  u  et  v ,           *****************
+c      xprimu et xprimv sont respectivement les valeurs de  dx/dX
+c      yprimu et yprimv    .  .  .  .  .  .  .  .  .  .  .  dy/dY
+c      rlatu  et  rlatv    .  .  .  .  .  .  .  .  .  .  .la latitude
+c      cvu    et   cv      .  .  .  .  .  .  .  .  .  .  .    cv
+c
+c  **************  aux points u, v, scalaires, et z  ****************
+c      cu, cuv, cuscal, cuz sont respectiv. les valeurs de    cu
+c
+c
+c
+c         Exemple de distribution de variables sur la grille dans le
+c             domaine de travail ( X,Y ) .
+c     ................................................................
+c                  DX=DY= 1
+c
+c   
+c        +     represente  un  point scalaire ( p.exp  la pression )
+c        >     represente  la composante zonale du  vent
+c        V     represente  la composante meridienne du vent
+c        o     represente  la  vorticite
+c
+c       ----  , car aux poles , les comp.zonales covariantes sont nulles
+c
+c
+c
+c         i ->
+c
+c         1      2      3      4      5      6      7      8
+c  j
+c  v  1   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     2   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     3   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     4   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
+c
+c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
+c
+c     5   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
+c
+c
+c      Ci-dessus,  on voit que le nombre de pts.en longitude est egal
+c                 a   IM = 8
+c      De meme ,   le nombre d'intervalles entre les 2 poles est egal
+c                 a   JM = 4
+c
+c      Les points scalaires ( + ) correspondent donc a des valeurs
+c       entieres  de  i ( 1 a IM )   et  de  j ( 1 a  JM +1 )   .
+c
+c      Les vents    U       ( > ) correspondent a des valeurs  semi-
+c       entieres  de i ( 1+ 0.5 a IM+ 0.5) et entieres de j ( 1 a JM+1)
+c
+c      Les vents    V       ( V ) correspondent a des valeurs entieres
+c       de     i ( 1 a  IM ) et semi-entieres de  j ( 1 +0.5  a JM +0.5)
+c
+c
+c
+      WRITE(6,3) 
+ 3    FORMAT( // 10x,' ....  INIGEOM  date du 01/06/98   ..... ',
+     * //5x,'   Calcul des elongations cu et cv  comme sommes des 4 ' /
+     *  5x,' elong. cuij1, .. 4  , cvij1,.. 4  qui les entourent , aux 
+     * '/ 5x,' memes endroits que les aires aireij1,...j4   . ' / )
+c
+c
+      IF( nitergdiv.NE.2 ) THEN
+        gamdi_gdiv = coefdis/ ( float(nitergdiv) -2. )
+      ELSE
+        gamdi_gdiv = 0.
+      ENDIF
+      IF( nitergrot.NE.2 ) THEN
+        gamdi_grot = coefdis/ ( float(nitergrot) -2. )
+      ELSE
+        gamdi_grot = 0.
+      ENDIF
+      IF( niterh.NE.2 ) THEN
+        gamdi_h = coefdis/ ( float(niterh) -2. )
+      ELSE
+        gamdi_h = 0.
+      ENDIF
+
+      WRITE(6,*) ' gamdi_gd ',gamdi_gdiv,gamdi_grot,gamdi_h,coefdis,
+     *  nitergdiv,nitergrot,niterh
+c
+      pi    = 2.* ASIN(1.)
+c
+      WRITE(6,990) 
+
+c     ----------------------------------------------------------------
+c
+      IF( .NOT.fxyhypb )   THEN
+c
+c
+       IF( ysinus )  THEN
+c
+        WRITE(6,*) ' ***  Inigeom ,  Y = Sinus ( Latitude ) *** '
+c
+c   .... utilisation de f(x,y )  avec  y  =  sinus de la latitude  .....
+
+        CALL  fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,                    rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       ELSE
+c
+        WRITE(6,*) '*** Inigeom ,  Y = Latitude  , der. sinusoid . ***'
+
+c  .... utilisation  de f(x,y) a tangente sinusoidale , y etant la latit. ...
+c
+ 
+        pxo   = clon *pi /180.
+        pyo   = 2.* clat* pi /180.
+c
+c  ....  determination de  transx ( pour le zoom ) par Newton-Raphson ...
+c
+        itmax = 10
+        eps   = .1e-7
+c
+        xo1 = 0.
+        DO 10 iter = 1, itmax
+        x1  = xo1
+        f   = x1+ alphax *SIN(x1-pxo)
+        df  = 1.+ alphax *COS(x1-pxo)
+        x1  = x1 - f/df
+        xdm = ABS( x1- xo1 )
+        IF( xdm.LE.eps )GO TO 11
+        xo1 = x1
+ 10     CONTINUE
+ 11     CONTINUE
+c
+        transx = xo1
+
+        itmay = 10
+        eps   = .1e-7
+C
+        yo1  = 0.
+        DO 15 iter = 1,itmay
+        y1   = yo1
+        f    = y1 + alphay* SIN(y1-pyo)
+        df   = 1. + alphay* COS(y1-pyo)
+        y1   = y1 -f/df
+        ydm  = ABS(y1-yo1)
+        IF(ydm.LE.eps) GO TO 17
+        yo1  = y1
+ 15     CONTINUE
+c
+ 17     CONTINUE
+        transy = yo1
+
+        CALL fxy ( rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
+     ,              rlatu2,yprimu2,
+     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
+
+       ENDIF
+c
+      ELSE
+c
+c   ....  Utilisation  de fxyhyper , f(x,y) a derivee tangente hyperbol.
+c   .....................................................................
+
+      WRITE(6,*)'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
+ 
+       CALL fxyhyper( clat, grossismy, dzoomy, tauy    , 
+     ,                clon, grossismx, dzoomx, taux    ,
+     , rlatu,yprimu,rlatv, yprimv,rlatu1, yprimu1,rlatu2,yprimu2  ,
+     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025 )
+
+  
+      ENDIF
+c
+c  -------------------------------------------------------------------
+
+c
+      rlatu(1)    =     ASIN(1.)
+      rlatu(jjp1) =  - rlatu(1)
+c
+c
+c   ....  calcul  aux  poles  ....
+c
+      yprimu(1)      = 0.
+      yprimu(jjp1)   = 0.
+c
+c
+      un4rad2 = 0.25 * rad * rad
+c
+c   --------------------------------------------------------------------
+c   --------------------------------------------------------------------
+c   -                                                                  -
+c   -  calcul  des aires ( aire,aireu,airev, 1./aire, 1./airez  )      -
+c   -      et de   fext ,  force de coriolis  extensive  .             -
+c   -                                                                  -
+c   --------------------------------------------------------------------
+c   --------------------------------------------------------------------
+c
+c
+c
+c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
+c   affectees 4 aires entourant P , calculees respectivement aux points
+c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
+c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
+c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
+c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
+c
+c           ,
+c   Les cotes de chacun de ces 4 carres etant egaux a 1/2 suivant (X,Y).
+c   Chaque aire centree en 1 point scalaire P(i,j) est egale a la somme
+c   des 4 aires  aireij1,aireij2,aireij3,aireij4 qui sont affectees au
+c   point (i,j) .
+c   On definit en outre les coefficients  alpha comme etant egaux a
+c    (aireij / aire), c.a.d par exp.  alpha1(i,j)=aireij1(i,j)/aire(i,j)
+c
+c   De meme, toute aire centree en 1 point U est egale a la somme des
+c   4 aires aireij1,aireij2,aireij3,aireij4 entourant le point U .
+c    Idem pour  airev, airez .
+c
+c       On a ,pour chaque maille :    dX = dY = 1
+c
+c
+c                             . V
+c
+c                 aireij4 .        . aireij1
+c
+c                   U .       . P      . U
+c
+c                 aireij3 .        . aireij2
+c
+c                             . V
+c
+c
+c
+c
+c
+c   ....................................................................
+c
+c    Calcul des 4 aires elementaires aireij1,aireij2,aireij3,aireij4
+c   qui entourent chaque aire(i,j) , ainsi que les 4 elongations elemen
+c   taires cuij et les 4 elongat. cvij qui sont calculees aux memes 
+c     endroits  que les aireij   .    
+c
+c   ....................................................................
+c
+c     .......  do 35  :   boucle sur les  jjm + 1  latitudes   .....
+c
+c
+      DO 35 j = 1, jjp1
+c
+      IF ( j. eq. 1 )  THEN
+c
+      yprm           = yprimu1(j)
+      rlatm          = rlatu1(j)
+c
+      coslatm        = COS( rlatm )
+      radclatm       = 0.5* rad * coslatm
+c
+      DO 30 i = 1, iim
+      xprp           = xprimp025( i )
+      xprm           = xprimm025( i )
+
+      aireij2( i,1 ) = un4rad2 * coslatm  * xprp * yprm
+      aireij3( i,1 ) = un4rad2 * coslatm  * xprm * yprm
+      cuij2  ( i,1 ) = radclatm * xprp
+      cuij3  ( i,1 ) = radclatm * xprm
+      cvij2  ( i,1 ) = 0.5* rad * yprm
+      cvij3  ( i,1 ) = cvij2(i,1)
+  30  CONTINUE
+c
+      DO  i = 1, iim
+      aireij1( i,1 ) = 0.
+      aireij4( i,1 ) = 0.
+      cuij1  ( i,1 ) = 0.
+      cuij4  ( i,1 ) = 0.
+      cvij1  ( i,1 ) = 0.
+      cvij4  ( i,1 ) = 0.
+      ENDDO
+c
+      END IF
+c
+      IF ( j. eq. jjp1 )  THEN
+       yprp               = yprimu2(j-1)
+       rlatp              = rlatu2 (j-1)
+ccc       yprp             = fyprim( FLOAT(j) - 0.25 )
+ccc       rlatp            = fy    ( FLOAT(j) - 0.25 )
+c
+      coslatp             = COS( rlatp )
+      radclatp            = 0.5* rad * coslatp
+c
+      DO 31 i = 1,iim
+        xprp              = xprimp025( i )
+        xprm              = xprimm025( i )
+        aireij1( i,jjp1 ) = un4rad2 * coslatp  * xprp * yprp
+        aireij4( i,jjp1 ) = un4rad2 * coslatp  * xprm * yprp
+        cuij1(i,jjp1)     = radclatp * xprp
+        cuij4(i,jjp1)     = radclatp * xprm
+        cvij1(i,jjp1)     = 0.5 * rad* yprp
+        cvij4(i,jjp1)     = cvij1(i,jjp1)
+ 31   CONTINUE
+c
+       DO   i    = 1, iim
+        aireij2( i,jjp1 ) = 0.
+        aireij3( i,jjp1 ) = 0.
+        cvij2  ( i,jjp1 ) = 0.
+        cvij3  ( i,jjp1 ) = 0.
+        cuij2  ( i,jjp1 ) = 0.
+        cuij3  ( i,jjp1 ) = 0.
+       ENDDO
+c
+      END IF
+c
+
+      IF ( j .gt. 1 .AND. j .lt. jjp1 )  THEN
+c
+        rlatp    = rlatu2 ( j-1 )
+        yprp     = yprimu2( j-1 )
+        rlatm    = rlatu1 (  j  )
+        yprm     = yprimu1(  j  )
+cc         rlatp    = fy    ( FLOAT(j) - 0.25 )
+cc         yprp     = fyprim( FLOAT(j) - 0.25 )
+cc         rlatm    = fy    ( FLOAT(j) + 0.25 )
+cc         yprm     = fyprim( FLOAT(j) + 0.25 )
+
+         coslatm  = COS( rlatm )
+         coslatp  = COS( rlatp )
+         radclatp = 0.5* rad * coslatp
+         radclatm = 0.5* rad * coslatm
+c
+         DO 32 i = 1,iim
+         xprp            = xprimp025( i )
+         xprm            = xprimm025( i )
+      
+         ai14            = un4rad2 * coslatp * yprp
+         ai23            = un4rad2 * coslatm * yprm
+         aireij1 ( i,j ) = ai14 * xprp
+         aireij2 ( i,j ) = ai23 * xprp
+         aireij3 ( i,j ) = ai23 * xprm
+         aireij4 ( i,j ) = ai14 * xprm
+         cuij1   ( i,j ) = radclatp * xprp
+         cuij2   ( i,j ) = radclatm * xprp
+         cuij3   ( i,j ) = radclatm * xprm
+         cuij4   ( i,j ) = radclatp * xprm
+         cvij1   ( i,j ) = 0.5* rad * yprp
+         cvij2   ( i,j ) = 0.5* rad * yprm
+         cvij3   ( i,j ) = cvij2(i,j)
+         cvij4   ( i,j ) = cvij1(i,j)
+  32     CONTINUE
+c
+      END IF
+c
+c    ........       periodicite   ............
+c
+         cvij1   (iip1,j) = cvij1   (1,j)
+         cvij2   (iip1,j) = cvij2   (1,j)
+         cvij3   (iip1,j) = cvij3   (1,j)
+         cvij4   (iip1,j) = cvij4   (1,j)
+         cuij1   (iip1,j) = cuij1   (1,j)
+         cuij2   (iip1,j) = cuij2   (1,j)
+         cuij3   (iip1,j) = cuij3   (1,j)
+         cuij4   (iip1,j) = cuij4   (1,j)
+         aireij1 (iip1,j) = aireij1 (1,j )
+         aireij2 (iip1,j) = aireij2 (1,j )
+         aireij3 (iip1,j) = aireij3 (1,j )
+         aireij4 (iip1,j) = aireij4 (1,j )
+        
+  35  CONTINUE
+c
+c    ..............................................................
+c
+      DO 37 j = 1, jjp1
+      DO 36 i = 1, iim
+      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
+     *                          aireij4(i,j)
+      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
+      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
+      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
+      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
+      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
+      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
+      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
+      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
+  36  CONTINUE
+c
+c
+      aire    (iip1,j) = aire    (1,j)
+      alpha1  (iip1,j) = alpha1  (1,j)
+      alpha2  (iip1,j) = alpha2  (1,j)
+      alpha3  (iip1,j) = alpha3  (1,j)
+      alpha4  (iip1,j) = alpha4  (1,j)
+      alpha1p2(iip1,j) = alpha1p2(1,j)
+      alpha1p4(iip1,j) = alpha1p4(1,j)
+      alpha2p3(iip1,j) = alpha2p3(1,j)
+      alpha3p4(iip1,j) = alpha3p4(1,j)
+  37  CONTINUE
+c
+
+      DO 42 j = 1,jjp1
+      DO 41 i = 1,iim
+      aireu       (i,j)= aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
+     *                                aireij3(i+1,j)
+      unsaire    ( i,j)= 1./ aire(i,j)
+      unsair_gam1( i,j)= unsaire(i,j)** ( - gamdi_gdiv )
+      unsair_gam2( i,j)= unsaire(i,j)** ( - gamdi_h    )
+      airesurg   ( i,j)= aire(i,j)/ g
+  41  CONTINUE
+      aireu     (iip1,j)  = aireu  (1,j)
+      unsaire   (iip1,j)  = unsaire(1,j)
+      unsair_gam1(iip1,j) = unsair_gam1(1,j)
+      unsair_gam2(iip1,j) = unsair_gam2(1,j)
+      airesurg   (iip1,j) = airesurg(1,j)
+  42  CONTINUE
+c
+c
+      DO 48 j = 1,jjm
+c
+        DO i=1,iim
+         airev     (i,j) = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
+     *                           aireij4(i,j+1)
+        ENDDO
+         DO i=1,iim
+          airez         = aireij2(i,j)+aireij1(i,j+1)+aireij3(i+1,j) +
+     *                           aireij4(i+1,j+1)
+          unsairez(i,j) = 1./ airez
+          unsairz_gam(i,j)= unsairez(i,j)** ( - gamdi_grot )
+          fext    (i,j)   = airez * SIN(rlatv(j))* 2.* omeg
+         ENDDO
+        airev     (iip1,j)  = airev(1,j)
+        unsairez  (iip1,j)  = unsairez(1,j)
+        fext      (iip1,j)  = fext(1,j)
+        unsairz_gam(iip1,j) = unsairz_gam(1,j)
+c
+  48  CONTINUE
+c
+c
+c    .....      Calcul  des elongations cu,cv, cvu     .........
+c
+      DO    j   = 1, jjm
+       DO   i  = 1, iim
+       cv(i,j) = 0.5 *( cvij2(i,j)+cvij3(i,j)+cvij1(i,j+1)+cvij4(i,j+1))
+       cvu(i,j)= 0.5 *( cvij1(i,j)+cvij4(i,j)+cvij2(i,j)  +cvij3(i,j) )
+       cuv(i,j)= 0.5 *( cuij2(i,j)+cuij3(i,j)+cuij1(i,j+1)+cuij4(i,j+1))
+       unscv2(i,j) = 1./ ( cv(i,j)*cv(i,j) )
+       ENDDO
+       DO   i  = 1, iim
+       cuvsurcv (i,j)    = airev(i,j)  * unscv2(i,j)
+       cvsurcuv (i,j)    = 1./cuvsurcv(i,j)
+       cuvscvgam1(i,j)   = cuvsurcv (i,j) ** ( - gamdi_gdiv )
+       cuvscvgam2(i,j)   = cuvsurcv (i,j) ** ( - gamdi_h )
+       cvscuvgam(i,j)    = cvsurcuv (i,j) ** ( - gamdi_grot )
+       ENDDO
+       cv       (iip1,j)  = cv       (1,j)
+       cvu      (iip1,j)  = cvu      (1,j)
+       unscv2   (iip1,j)  = unscv2   (1,j)
+       cuv      (iip1,j)  = cuv      (1,j)
+       cuvsurcv (iip1,j)  = cuvsurcv (1,j)
+       cvsurcuv (iip1,j)  = cvsurcuv (1,j)
+       cuvscvgam1(iip1,j) = cuvscvgam1(1,j)
+       cuvscvgam2(iip1,j) = cuvscvgam2(1,j)
+       cvscuvgam(iip1,j)  = cvscuvgam(1,j)
+      ENDDO
+
+      DO  j     = 2, jjm
+        DO   i  = 1, iim
+        cu(i,j) = 0.5*(cuij1(i,j)+cuij4(i+1,j)+cuij2(i,j)+cuij3(i+1,j))
+        unscu2    (i,j)  = 1./ ( cu(i,j) * cu(i,j) )
+        cvusurcu  (i,j)  =  aireu(i,j) * unscu2(i,j)
+        cusurcvu  (i,j)  = 1./ cvusurcu(i,j)
+        cvuscugam1 (i,j) = cvusurcu(i,j) ** ( - gamdi_gdiv ) 
+        cvuscugam2 (i,j) = cvusurcu(i,j) ** ( - gamdi_h    ) 
+        cuscvugam (i,j)  = cusurcvu(i,j) ** ( - gamdi_grot )
+        ENDDO
+        cu       (iip1,j)  = cu(1,j)
+        unscu2   (iip1,j)  = unscu2(1,j)
+        cvusurcu (iip1,j)  = cvusurcu(1,j)
+        cusurcvu (iip1,j)  = cusurcvu(1,j)
+        cvuscugam1(iip1,j) = cvuscugam1(1,j)
+        cvuscugam2(iip1,j) = cvuscugam2(1,j)
+        cuscvugam (iip1,j) = cuscvugam(1,j)
+      ENDDO
+
+c
+c   ....  calcul aux  poles  ....
+c
+      DO    i      =  1, iip1
+        cu    ( i, 1 )  =   0.
+        unscu2( i, 1 )  =   0.
+        cvu   ( i, 1 )  =   0.
+c
+        cu    (i, jjp1) =   0.
+        unscu2(i, jjp1) =   0.
+        cvu   (i, jjp1) =   0.
+      ENDDO
+c
+c    ..............................................................
+c
+      DO j = 1, jjm
+        DO i= 1, iim
+         airvscu2  (i,j) = airev(i,j)/ ( cuv(i,j) * cuv(i,j) )
+         aivscu2gam(i,j) = airvscu2(i,j)** ( - gamdi_grot )
+        ENDDO
+         airvscu2  (iip1,j)  = airvscu2(1,j)
+         aivscu2gam(iip1,j)  = aivscu2gam(1,j)
+      ENDDO
+
+      DO j=2,jjm
+        DO i=1,iim
+         airuscv2   (i,j)    = aireu(i,j)/ ( cvu(i,j) * cvu(i,j) )
+         aiuscv2gam (i,j)    = airuscv2(i,j)** ( - gamdi_grot ) 
+        ENDDO
+         airuscv2  (iip1,j)  = airuscv2  (1,j)
+         aiuscv2gam(iip1,j)  = aiuscv2gam(1,j)
+      ENDDO
+
+c
+c   calcul des aires aux  poles :
+c   -----------------------------
+c
+      apoln       = SSUM(iim,aire(1,1),1)
+      apols       = SSUM(iim,aire(1,jjp1),1)
+      unsapolnga1 = 1./ ( apoln ** ( - gamdi_gdiv ) )
+      unsapolsga1 = 1./ ( apols ** ( - gamdi_gdiv ) )
+      unsapolnga2 = 1./ ( apoln ** ( - gamdi_h    ) )
+      unsapolsga2 = 1./ ( apols ** ( - gamdi_h    ) )
+c
+c-----------------------------------------------------------------------
+c     gtitre='Coriolis version ancienne'
+c     gfichier='fext1'
+c     CALL writestd(fext,iip1*jjm)
+c
+c   changement F. Hourdin calcul conservatif pour fext
+c   constang contient le produit a * cos ( latitude ) * omega
+c
+      DO i=1,iim
+         constang(i,1) = 0.
+      ENDDO
+      DO j=1,jjm-1
+        DO i=1,iim
+         constang(i,j+1) = rad*omeg*cu(i,j+1)*COS(rlatu(j+1))
+        ENDDO
+      ENDDO
+      DO i=1,iim
+         constang(i,jjp1) = 0.
+      ENDDO
+c
+c   periodicite en longitude
+c
+      DO j=1,jjm
+        fext(iip1,j)     = fext(1,j)
+      ENDDO
+      DO j=1,jjp1
+        constang(iip1,j) = constang(1,j)
+      ENDDO
+
+c fin du changement
+
+c
+c-----------------------------------------------------------------------
+c
+       WRITE(6,*) '   ***  Coordonnees de la grille  *** '
+       WRITE(6,995)
+c
+       WRITE(6,*) '   LONGITUDES  aux pts.   V  ( degres )  '
+       WRITE(6,995)
+        DO i=1,iip1
+         rlonvv(i) = rlonv(i)*180./pi
+        ENDDO
+       WRITE(6,400) rlonvv
+c
+       WRITE(6,995)
+       WRITE(6,*) '   LATITUDES   aux pts.   V  ( degres )  '
+       WRITE(6,995)
+        DO i=1,jjm
+         rlatuu(i)=rlatv(i)*180./pi
+        ENDDO
+       WRITE(6,400) (rlatuu(i),i=1,jjm)
+c
+        DO i=1,iip1
+          rlonvv(i)=rlonu(i)*180./pi
+        ENDDO
+       WRITE(6,995)
+       WRITE(6,*) '   LONGITUDES  aux pts.   U  ( degres )  '
+       WRITE(6,995)
+       WRITE(6,400) rlonvv
+       WRITE(6,995)
+
+       WRITE(6,*) '   LATITUDES   aux pts.   U  ( degres )  '
+       WRITE(6,995)
+        DO i=1,jjp1
+         rlatuu(i)=rlatu(i)*180./pi
+        ENDDO
+       WRITE(6,400) (rlatuu(i),i=1,jjp1)
+       WRITE(6,995)
+c
+444    format(f10.3,f6.0)
+400    FORMAT(1x,8f8.2)
+990    FORMAT(//)
+995    FORMAT(/)
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigrads.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigrads.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/inigrads.F	(revision 46)
@@ -0,0 +1,77 @@
+      subroutine inigrads(if,im
+     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
+     s  ,dt,file,titlel)
+
+
+      implicit none
+
+      integer if,im,jm,lm,i,j,l,lnblnk
+      real x(im),y(jm),z(lm),fx,fy,fz,dt
+      real xmin,xmax,ymin,ymax
+
+      character file*10,titlel*40
+
+#include "gradsdef.h"
+
+      data unit/66,32,34,36,38,40,42,44,46,48/
+      data nf/0/
+
+      if (if.le.nf) stop'verifier les appels a inigrads'
+
+      print*,'Entree dans inigrads'
+
+      nf=if
+      title(if)=titlel
+      ivar(if)=0
+
+      fichier(if)=file(1:lnblnk(file))
+
+      firsttime(if)=.true.
+      dtime(if)=dt
+
+      iid(if)=1
+      ifd(if)=im
+      imd(if)=im
+      do i=1,im
+         xd(i,if)=x(i)*fx
+         if(xd(i,if).lt.xmin) iid(if)=i+1
+         if(xd(i,if).le.xmax) ifd(if)=i
+      enddo
+      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
+
+      jid(if)=1
+      jfd(if)=jm
+      jmd(if)=jm
+      do j=1,jm
+         yd(j,if)=y(j)*fy
+         if(yd(j,if).gt.ymax) jid(if)=j+1
+         if(yd(j,if).ge.ymin) jfd(if)=j
+      enddo
+      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
+
+      print*,'Open de dat'
+      print*,'file=',file
+      print*,'fichier(if)=',fichier(if)
+
+      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
+      print*,file(1:lnblnk(file))//'.dat'
+
+      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat',
+     s   FORM='UNFORMATTED',
+     s   ACCESS='DIRECT'
+     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
+
+      print*,'Open de dat ok'
+
+      lmd(if)=lm
+      do l=1,lm
+         zd(l,if)=z(l)*fz
+      enddo
+
+      irec(if)=0
+
+      print*,if,imd(if),jmd(if),lmd(if)
+      print*,'if,imd(if),jmd(if),lmd(if)'
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniinterp_h.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniinterp_h.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/iniinterp_h.F	(revision 46)
@@ -0,0 +1,239 @@
+      subroutine iniinterp_h (imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &       ktotal,iik,jjk,jk,ik,intersec,airen)
+   
+      implicit none
+
+
+
+c ---------------------------------------------------------
+c Prepare l' interpolation des variables d'une grille LMDZ
+c  dans une autre grille LMDZ en conservant la quantite
+c  totale pour les variables intensives (/m2) : ex : Pression au sol
+c
+c   (Pour chaque case autour d'un point scalaire de la nouvelle
+c    grille, on calcule la surface (en m2)en intersection avec chaque
+c    case de l'ancienne grille , pour la future interpolation)
+c
+c on calcule aussi l' aire dans la nouvelle grille 
+c
+c
+c   Auteur:  F.Forget 01/1995
+c   -------
+c
+c ---------------------------------------------------------
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+c INPUT
+       integer imo, jmo ! dimensions ancienne grille
+       integer imn,jmn  ! dimensions nouvelle grille
+       integer kmax ! taille du tableau des intersections
+       real rlonuo(imo+1)     !  Latitude et
+       real rlatvo(jmo)       !  longitude des
+       real rlonun(imn+1)     !  bord des
+       real rlatvn(jmn)     !  cases "scalaires" (input)
+
+c OUTPUT
+       integer ktotal ! nombre totale d''intersections reperees
+       integer iik(kmax), jjk(kmax),jk(kmax),ik(kmax)
+       real intersec(kmax)  ! surface des intersections (m2)
+       real airen (imn+1,jmn+1) ! aire dans la nouvelle grille
+
+
+       
+ 
+c Autres variables
+c """"""""""""""""
+       integer i,j,ii,jj
+       integer imomx,jmomx,imnmx1,jmnmx1
+!       parameter (imomx=361,jmomx=180,imnmx1=190,jmnmx1=100)
+       parameter (imomx=361,jmomx=180,imnmx1=360,jmnmx1=190)
+       real a(imomx+1),b(imomx+1),c(jmomx+1),d(jmomx+1)
+       real an(imnmx1+1),bn(imnmx1+1)
+       real cn(jmnmx1+1),dn(jmnmx1+1)
+       real aa, bb,cc,dd
+       real pi
+
+       pi      = 2.*ASIN( 1. )
+
+c Test dimensions imnmx1 jmnmx1
+c""""""""""""""""""""""""""""""
+c test dimensionnement tableau airetest
+      if (imn.GT.imnmx1.OR.jmn.GT.jmnmx1) then
+        write(*,*) 'STOP pb dimensionnement'
+        write(*,*) 'il faut imn < imnmx1 et jmn < jmnmx1'
+        write(*,*) 'imn imnmx1', imn,imnmx1
+        write(*,*) 'jmn jmnmx1', jmn,jmnmx1
+        call exit(1)
+      endif
+
+      if (imo.GT.imomx.OR.jmo.GT.jmomx) then
+        write(*,*) 'STOP pb dimensionnement'
+        write(*,*) 'il faut imo < imomx et jmo < jmomx'
+        write(*,*) 'imo imomx', imo,imomx
+        write(*,*) 'jmo jmomx', jmo,jmomx
+        call exit(1)
+      endif
+
+c On repere les frontieres des cases :
+c =================================== 
+c
+c Attention, on ruse avec des latitudes = 90 deg au pole.
+
+
+c  Ancienne grile
+c  """"""""""""""
+      a(1) =   - rlonuo(imo+1)
+      b(1) = rlonuo(1)
+      do i=2,imo+1
+         a(i) = rlonuo(i-1)
+         b(i) =  rlonuo(i)
+      end do
+
+      d(1) = pi/2 
+      do j=1,jmo
+         c(j) = rlatvo(j) 
+         d(j+1) = rlatvo(j)
+      end do
+      c(jmo+1) = -pi/2 
+      
+
+c  Nouvelle grille
+c  """""""""""""""
+      an(1) =  - rlonun(imn+1)
+      bn(1) = rlonun(1)
+      do i=2,imn+1
+         an(i) = rlonun(i-1)
+         bn(i) =  rlonun(i)
+      end do
+
+      dn(1) = pi/2 
+      do j=1,jmn
+         cn(j) = rlatvn(j)
+         dn(j+1) = rlatvn(j)
+      end do
+      cn(jmn+1) = -pi/2 
+
+c Calcul de la surface des cases scalaires de la nouvelle grille
+c ==============================================================
+      do ii=1,imn + 1
+        do jj = 1,jmn+1
+           airen(ii,jj) = (bn(ii)-an(ii))*(sin(dn(jj))-sin(cn(jj)))
+        end do
+      end do
+
+c Calcul de la surface des intersections
+c ======================================
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c test dimenssion kmax (calcul de ktotal)
+c"""""""""""""""""""""""""""""""""""""""
+c Calcul de ktotal, mais ralonge beaucoup en temps => pour debug
+      write(*,*) 
+      write(*,*) 'DEBUT DU TEST KMAX'
+      ktotal = 0
+      do jj = 1,jmn+1
+       do j=1, jmo+1
+          if((cn(jj).lt.d(j)).and.(dn(jj).gt.c(j)))then
+              do ii=1,imn + 1
+                do i=1, imo +1
+                    if (  ((an(ii).lt.b(i)).and.(bn(ii).gt.a(i)))
+     &        .or. ((an(ii).lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi)
+     &             .and.(b(i)-2*pi.lt.-pi) )
+     &        .or. ((an(ii).lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi)
+     &             .and.(a(i)+2*pi.gt.pi) )
+     &                     )then
+                      ktotal = ktotal +1
+                     end if
+                enddo
+              enddo
+           end if
+        enddo
+      enddo
+
+      if (kmax.LT.ktotal) then
+         write(*,*)
+         write(*,*) '******** ATTENTION ********' 
+         write(*,*) 'kmax =',kmax 
+         write(*,*) 'ktotal =',ktotal 
+         write(*,*) 'Changer la valeur de kmax dans interp_horiz.F ' 
+         write(*,*) 'avec kmax >= ktotal' 
+         write(*,*) 'EXIT dans iniinterp_h'
+         call exit(1)
+      else
+         write(*,*) 'kmax =',kmax 
+         write(*,*) 'ktotal =',ktotal
+      end if
+      write(*,*) 'FIN DU TEST KMAX'
+      write(*,*) 
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c     boucle sur la nouvelle grille
+c     """"""""""""""""""""""""""""
+      ktotal = 0
+      do jj = 1,jmn+1
+       do j=1, jmo+1
+          if((cn(jj).lt.d(j)).and.(dn(jj).gt.c(j)))then
+              do ii=1,imn + 1
+                do i=1, imo +1
+                    if (  ((an(ii).lt.b(i)).and.(bn(ii).gt.a(i)))
+     &        .or. ((an(ii).lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi)
+     &             .and.(b(i)-2*pi.lt.-pi) )
+     &        .or. ((an(ii).lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi)
+     &             .and.(a(i)+2*pi.gt.pi) )
+     &                     )then
+                      ktotal = ktotal +1
+                      iik(ktotal) =ii
+                      jjk(ktotal) =jj
+                      ik(ktotal) =i
+                      jk(ktotal) =j
+
+                      dd = min(d(j), dn(jj))
+                      cc = cn(jj)
+                      if (cc.lt. c(j))cc=c(j)
+                      if((an(ii).lt.b(i)-2*pi).and.
+     &                  (bn(ii).gt.a(i)-2*pi)) then 
+                          bb = min(b(i)-2*pi,bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)-2*pi) aa=a(i)-2*pi
+                      else if((an(ii).lt.b(i)+2*pi).and.
+     &                       (bn(ii).gt.a(i)+2*pi)) then
+                          bb = min(b(i)+2*pi,bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)+2*pi) aa=a(i)+2*pi
+                      else 
+                          bb = min(b(i),bn(ii))
+                          aa = an(ii)
+                          if (aa.lt.a(i)) aa=a(i)
+                      end if
+                      intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc))
+                     end if
+                end do
+               end do
+             end if
+         end do
+       end do       
+
+
+c     TEST  INFO
+c     DO k=1,ktotal 
+c      ii = iik(k) 
+c      jj = jjk(k)
+c      i = ik(k)
+c      j = jk(k)
+c      if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))then
+c      if (jj.eq.2.and.(ii.eq.1))then
+c          write(*,*) '**************** jj=',jj,'ii=',ii
+c          write(*,*) 'i,j =',i,j
+c          write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
+c          write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
+c          write(*,*) 'intersec(k)',intersec(k)
+c          write(*,*) 'airen(ii,jj)=',airen(ii,jj)
+c      end if
+c     END DO 
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/initial0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/initial0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/initial0.F	(revision 46)
@@ -0,0 +1,9 @@
+      SUBROUTINE initial0(n,x)
+      IMPLICIT NONE
+      INTEGER n,i
+      REAL x(n)
+      DO 10 i=1,n
+         x(i)=0.
+10    CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/integrd.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/integrd.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/integrd.F	(revision 46)
@@ -0,0 +1,187 @@
+      SUBROUTINE integrd
+     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
+
+      IMPLICIT NONE
+
+
+c=======================================================================
+cccccccccccccccccccccccccccccccccccccccccccc
+c
+!Mars       VERSION MARTIENNE de integrd.F
+c
+c   ..   modification de l'integration de  q   . 26/04/94 ..
+c   ....   Si shema Van-leer pour advection de q , on n'integre pas  q
+c      car q  a ete deja integre   dans "tracvl.F" appele par vanleer   ...
+cccccccccccccccccccccccccccccccccccccccccccc
+
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   objet:
+c   ------
+c
+c   Incrementation des tendances dynamiques
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "logic.h"
+#include "temps.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER nq
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nq)
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
+
+      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
+      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
+
+      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
+      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
+      REAL p(ip1jmp1,llmp1)
+      REAL tpn,tps,tppn(iim),tpps(iim)
+      REAL qpn,qps,qppn(iim),qpps(iim)
+      REAL deltap( ip1jmp1,llm )
+
+      INTEGER  l,ij,iq
+
+      EXTERNAL  filtreg,massdair,pression
+      EXTERNAL  SCOPY 
+      REAL SSUM
+      EXTERNAL SSUM
+
+c-----------------------------------------------------------------------
+
+      DO  l = 1,llm
+        DO  ij = 1,iip1
+         ucov(    ij    , l) = 0.
+         ucov( ij +ip1jm, l) = 0.
+         uscr(     ij      ) = 0.
+         uscr( ij +ip1jm   ) = 0.
+        ENDDO
+      ENDDO
+
+
+c    ............    integration  de       ps         ..............
+
+      CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
+
+      DO 2 ij = 1,ip1jmp1
+       pscr (ij)    = ps(ij)
+       ps (ij)      = psm1(ij) + dt * dp(ij)
+
+   2  CONTINUE
+c
+      DO ij = 1,ip1jmp1
+        IF( ps(ij).LT.0. ) THEN
+         PRINT*,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
+         write(*,*)'psm1(ij)=',psm1(ij),' dp(ij)=',dp(ij),
+     &             'dp(ij)*dt=',dp(ij)*dt
+         STOP' dans integrd'
+        ENDIF
+      ENDDO
+c
+      IF( alphax.NE.0. )   THEN
+         DO  ij    = 1, iim
+          tppn(ij) = aire(   ij   ) * ps(  ij    )
+          tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
+         ENDDO
+          tpn      = SSUM(iim,tppn,1)/apoln
+          tps      = SSUM(iim,tpps,1)/apols
+         DO ij   = 1, iip1
+          ps(   ij   )  = tpn
+          ps(ij+ip1jm)  = tps
+         ENDDO
+      ENDIF
+c
+c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
+c
+      CALL pression ( ip1jmp1, ap, bp, ps, p )
+      CALL massdair (     p  , masse         )
+
+      CALL SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+      CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
+c
+
+c    ............   integration  de  ucov, vcov,  h     ..............
+
+      DO 10 l = 1,llm
+
+      DO 4 ij = iip2,ip1jm
+      uscr( ij )   =  ucov( ij,l )
+      ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
+   4  CONTINUE
+
+      DO 5 ij = 1,ip1jm
+      vscr( ij )   =  vcov( ij,l )
+      vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
+   5  CONTINUE
+
+      DO 6 ij = 1,ip1jmp1
+      hscr( ij )    =  teta(ij,l)
+      teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l) 
+     $                + dt * dteta(ij,l) / masse(ij,l)
+   6  CONTINUE
+
+c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
+c
+c
+      DO  ij   = 1, iim
+        tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
+        tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
+      ENDDO
+        tpn      = SSUM(iim,tppn,1)/apoln
+        tps      = SSUM(iim,tpps,1)/apols
+
+      DO ij   = 1, iip1
+        teta(   ij   ,l)  = tpn
+        teta(ij+ip1jm,l)  = tps
+      ENDDO
+c
+
+      IF(leapf)  THEN
+         CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
+         CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
+         CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
+      END IF
+
+  10  CONTINUE
+
+
+c
+c   .......  integration de   q   ......
+c
+c
+c     .....   FIN  de l'integration  de   q    .......
+
+c    .................................................................
+
+
+      IF( leapf )  THEN
+         CALL SCOPY (    ip1jmp1 ,  pscr   , 1,   psm1  , 1 )
+         CALL SCOPY ( ip1jmp1*llm, massescr, 1,  massem1, 1 )
+      END IF
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_horiz.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_horiz.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_horiz.F	(revision 46)
@@ -0,0 +1,201 @@
+      subroutine interp_horiz (varo,varn,imo,jmo,imn,jmn,lm,
+     &  rlonuo,rlatvo,rlonun,rlatvn)  
+
+c===========================================================
+c  Interpolation Horizontales des variables d'une grille LMDZ
+c (des points SCALAIRES au point SCALAIRES)
+c  dans une autre grille LMDZ en conservant la quantite
+c  totale pour les variables intensives (/m2) : ex : Pression au sol
+c
+c Francois Forget (01/1995)
+c===========================================================
+
+      IMPLICIT NONE 
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+        
+       INTEGER imo, jmo ! dimensions ancienne grille (input)
+       INTEGER imn,jmn  ! dimensions nouvelle grille (input)
+
+       REAL rlonuo(imo+1)     !  Latitude et
+       REAL rlatvo(jmo)       !  longitude des
+       REAL rlonun(imn+1)     !  bord des 
+       REAL rlatvn(jmn)     !  cases "scalaires" (input)
+
+       INTEGER lm ! dimension verticale (input)
+       REAL varo (imo+1, jmo+1,lm) ! var dans l'ancienne grille (input)
+       REAL varn (imn+1,jmn+1,lm) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       INTEGER imnmx2,jmnmx2
+c       parameter (imnmx2=190,jmnmx2=100)
+       parameter (imnmx2=360,jmnmx2=190)
+       REAL airetest(imnmx2+1,jmnmx2+1)
+       INTEGER ii,jj,l
+
+       REAL airen ((imnmx2+1)*(jmnmx2+1)) ! aire dans la nouvelle grille
+       REAL airentotn	! aire totale pole nord dans la nouvelle grille
+       REAL airentots	! aire totale pole sud dans la nouvelle grille
+c    Info sur les ktotal intersection entre les cases new/old grille
+
+c kmax: le nombre  max  d'intersections entre les 2 grilles horizontales
+c On fixe kmax a la taille de la grille des donnees martiennes (360x179) 
+c + des pouiemes (cas ou une maille est a cheval sur 2 ou 4 mailles)
+c  Il y a un test dans iniinterp_h pour s'assurer que ktotal < kmax
+       INTEGER kmax, k, ktotal
+       parameter (kmax = 360*179 + 200000)
+c      parameter (kmax = 360*179 + 40000)
+
+       INTEGER iik(kmax), jjk(kmax),jk(kmax),ik(kmax)
+       REAL intersec(kmax)
+       REAL R
+       REAL totn, tots
+       integer prev_sumdim
+       save prev_sumdim
+       data prev_sumdim /0/
+       
+
+       logical firsttest, aire_ok
+       save firsttest
+       data firsttest /.true./
+       data aire_ok /.true./
+
+       integer imoS,jmoS,imnS,jmnS
+       save imoS,jmoS,imnS,jmnS
+       save ktotal,iik,jjk,jk,ik,intersec,airen
+       REAL pi
+
+c Test dimensions imnmx2 jmnmx2
+c""""""""""""""""""""""""""""""
+c test dimensionnement tableau airetest
+      if (imn.GT.imnmx2.OR.jmn.GT.jmnmx2) then
+         write(*,*) 'STOP pb dimensionnement tableau airetest'
+         write(*,*) 'il faut imn < imnmx2 et jmn < jmnmx2'
+         write(*,*) 'imn imnmx2', imn,imnmx2
+         write(*,*) 'jmn jmnmx2', jmn,jmnmx2
+         call exit(1)
+      endif
+
+c initialisation
+c --------------
+c Si c'est le premier appel,  on prepare l'interpolation
+c en calculant pour chaque case autour d'un point scalaire de la
+c nouvelle grille, la surface  de intersection avec chaque
+c    case de l'ancienne grille.
+
+c  This must also be done if we change the dimension
+      if (imo+jmo+imn+jmn.ne.prev_sumdim) then
+          firsttest=.true.
+          prev_sumdim=imo+jmo+imn+jmn
+      end if       
+
+      if (firsttest) then 
+        call iniinterp_h(imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &          ktotal,iik,jjk,jk,ik,intersec,airen)
+       imoS=imo
+       jmoS=jmo
+       imnS=imn
+       jmnS=jmn
+      else
+       if(imo.NE.imoS.OR.jmo.NE.jmoS.OR.imn.NE.imnS.OR.jmn.NE.jmnS) then
+        call iniinterp_h(imo,jmo,imn,jmn ,kmax,
+     &       rlonuo,rlatvo,rlonun,rlatvn,
+     &          ktotal,iik,jjk,jk,ik,intersec,airen)
+       imoS=imo
+       jmoS=jmo
+       imnS=imn
+       jmnS=jmn
+       end if
+      end if
+
+      do l=1,lm
+       do jj =1 , jmn+1
+        do ii=1, imn+1
+          varn(ii,jj,l) =0.
+        end do
+       end do
+      end do 
+       
+c Interpolation horizontale
+c -------------------------
+c boucle sur toute les ktotal intersections entre les cases
+c de l'ancienne et la  nouvelle grille
+c
+     
+      do k=1,ktotal
+        do l=1,lm
+         varn(iik(k),jjk(k),l) = varn(iik(k),jjk(k),l) 
+     &   + varo(ik(k), jk(k),l)*intersec(k)/airen(iik(k)
+     &   +(jjk(k)-1)*(imn+1))
+        end do
+      end do
+
+c Une seule valeur au pole pour les variables ! :
+c -----------------------------------------------
+      DO l=1, lm
+         totn =0.
+         tots =0.
+
+
+c moyenne du champ au poles (ponderee par les aires)
+c"""""""""""""""""""""""""""""""
+         airentotn=0.
+         airentots=0.
+
+         do ii =1, imn+1
+            totn = totn + varn(ii,1,l)*airen(ii)
+            tots = tots + varn (ii,jmn+1,l)*airen(jmn*(imn+1)+ii)
+            airentotn=airentotn + airen(ii)
+            airentots=airentots + airen(jmn*(imn+1)+ii)
+         end do 
+
+         do ii =1, imn+1
+            varn(ii,1,l) = totn/airentotn
+            varn(ii,jmn+1,l) = tots/airentots
+         end do 
+
+      ENDDO
+           
+
+c---------------------------------------------------------------
+c  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST 
+      if (firsttest) then
+      pi=2.*asin(1.)
+      firsttest = .false.
+      write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:'
+
+      do jj =1 , jmn+1
+        do ii=1, imn+1
+          airetest(ii,jj) =0.
+        end do
+      end do 
+      do k=1,ktotal
+         airetest(iik(k),jjk(k))= airetest(iik(k),jjk(k)) +intersec(k) 
+      end do
+      do jj =1 , jmn+1
+       do ii=1, imn+1
+         r = airen(ii+(jj-1)*(imn+1))/airetest(ii,jj)
+         if ((r.gt.1.001).or.(r.lt.0.999)) then
+             write (*,*) '********** PROBLEME D'' AIRES !!!',
+     &                   ' DANS L''INTERPOLATION HORIZONTALE'
+             write(*,*)'ii,jj,airen,airetest',
+     &          ii,jj,airen(ii+(jj-1)*(imn+1)),airetest(ii,jj)
+             aire_ok = .false.
+         end if
+       end do
+      end do
+      if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK'
+      endif
+
+c FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST  FIN TEST
+c --------------------------------------------------------------------
+
+
+        return
+        end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_vert.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_vert.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/interp_vert.F	(revision 46)
@@ -0,0 +1,70 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
+     &             aps,bps,ps,Nhoriz)
+c
+c interpolation lineaire pour passer
+c a une nouvelle discretisation verticale pour
+c les variables de GCM
+c Francois Forget (01/1995)
+c Modif pour coordonnees hybrides FF (03/2003)
+c**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (input)
+
+       integer Nhoriz ! nombre de point horizontale (input)
+       real ps(nhoriz) !pression de surface (input)
+
+       real varo(Nhoriz,lmo) ! var dans l''ancienne grille (input)
+       real varn(Nhoriz,lmn) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       integer n, ln ,lo 
+       real coef
+       REAL sigmo(lmo) ! niveau sigma des variables dans les anciennes coord
+       REAL sigmn(lmn) ! niveau sigma des variables dans les nouvelles coord
+
+c run
+c ====
+
+      do n=1,Nhoriz
+        do ln=1,lmn
+            sigmn(ln)=aps(ln)/ps(n)+bps(ln)
+        end do
+        do lo=1,lmo
+            sigmo(lo)=apso(lo)/ps(n)+bpso(lo)
+        end do
+
+        do ln=1,lmn
+           if (sigmn(ln).ge.sigmo(1))then
+             varn(n,ln) =  varo(n,1)  
+           else if (sigmn(ln).le.sigmo(lmo)) then
+             varn(n,ln) =  varo(n,lmo)
+           else
+              do lo =1,lmo-1 
+                if ( (sigmn(ln).le.sigmo(lo)).and.
+     &             (sigmn(ln).gt.sigmo(lo+1)) )then
+                  coef = (sigmn(ln)-sigmo(lo))/(sigmo(lo+1)-sigmo(lo))
+                   varn(n,ln)=varo(n,lo) +coef*(varo(n,lo+1)-varo(n,lo))
+                end if
+              end do           
+           end if
+         end do
+
+      end do
+
+
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien.F	(revision 46)
@@ -0,0 +1,38 @@
+      SUBROUTINE laplacien ( klevel, teta, divgra )
+c
+c     P. Le Van
+c
+c   ************************************************************
+c    ....     calcul de  (div( grad ))   de   teta  .....
+c   ************************************************************
+c     klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    .........      variables  en arguments   ..............
+c
+      INTEGER klevel
+      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+c
+c    ............     variables  locales      ..............
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c    .......................................................
+
+      EXTERNAL  SCOPY, grad, divergf, filtreg
+
+c
+      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
+
+      CALL filtreg( divgra,  jjp1, klevel,  2, 1, .TRUE., 1 )
+      CALL grad ( klevel,divgra,   ghx , ghy              )
+      CALL divergf ( klevel, ghx , ghy  , divgra           )
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_gam.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_gam.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_gam.F	(revision 46)
@@ -0,0 +1,52 @@
+      SUBROUTINE laplacien_gam ( klevel, cuvsga, cvusga, unsaigam ,
+     *                        unsapolnga, unsapolsga, teta, divgra )
+
+c  P. Le Van
+c
+c   ************************************************************
+c
+c      ....   calcul de  (div( grad ))   de   teta  .....
+c   ************************************************************
+c    klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    ............     variables  en arguments    ..........
+c
+      INTEGER klevel
+      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
+      REAL cuvsga(ip1jm) , cvusga( ip1jmp1 ),unsaigam(ip1jmp1),
+     *     unsapolnga, unsapolsga
+c
+c    ...........    variables  locales    .................
+c
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c    ......................................................
+
+      EXTERNAL  filtreg
+      EXTERNAL  SCOPY, grad, divergst
+c
+c
+c   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
+c   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
+c   ...  unsairegam =  1. /  aire ** (- gamdissip )
+c
+
+      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
+c
+      CALL grad ( klevel, divgra, ghx, ghy )
+c
+      CALL diverg_gam ( klevel, cuvsga, cvusga,  unsaigam  ,
+     *                 unsapolnga, unsapolsga, ghx , ghy , divgra )
+
+c
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rot.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rot.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rot.F	(revision 46)
@@ -0,0 +1,37 @@
+      SUBROUTINE laplacien_rot ( klevel, rotin, rotout,ghx,ghy )
+c
+c    P. Le Van
+c
+c   ************************************************************
+c    ...  calcul de  ( rotat x nxgrad )  du rotationnel rotin  .
+c   ************************************************************
+c
+c     klevel et rotin  sont des arguments  d'entree pour le s-prog
+c      rotout           est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c 
+c   ..........    variables  en  arguments     .............
+c
+      INTEGER klevel
+      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
+c
+c   ..........    variables   locales       ................
+c
+      REAL ghy(ip1jm,klevel), ghx(ip1jmp1,klevel)
+c   ........................................................
+c
+      EXTERNAL  filtreg, nxgrad, rotatf
+c
+      CALL filtreg ( rotin ,   jjm, klevel,   2, 1, .FALSE., 1 )
+
+      CALL nxgrad ( klevel, rotin,   ghx ,  ghy               )
+      CALL rotatf  ( klevel, ghx  ,   ghy , rotout             )
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rotgam.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rotgam.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/laplacien_rotgam.F	(revision 46)
@@ -0,0 +1,42 @@
+      SUBROUTINE laplacien_rotgam ( klevel, rotin, rotout )
+c
+c     P. Le Van
+c
+c   ************************************************************
+c   ... calcul de  (rotat x nxgrad)_gam  du rotationnel rotin ..
+c   ************************************************************
+c     klevel et teta  sont des arguments  d'entree pour le s-prog
+c      divgra     est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c
+c    .............   variables  en  arguments    ...........
+c
+      INTEGER klevel
+      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
+c
+c   ............     variables   locales     ...............
+c
+      INTEGER l, ij
+      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
+c   ........................................................
+c
+      EXTERNAL   nxgrad_gam, rotat_nfil
+c
+
+      CALL nxgrad_gam ( klevel, rotin,   ghx ,   ghy  )
+      CALL rotat_nfil ( klevel, ghx  ,   ghy , rotout )
+c
+      DO l = 1, klevel
+        DO ij = 1, ip1jm
+         rotout(ij,l) = rotout(ij,l) * unsairz_gam(ij)
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lect_start_archive.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lect_start_archive.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lect_start_archive.F	(revision 46)
@@ -0,0 +1,1496 @@
+      SUBROUTINE lect_start_archive(date,tsurf,tsoil,emis,q2,
+     &     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,
+     &     q,qsurf,surfith,nid)
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "lmdstd.h"
+#include "netcdf.inc"
+!#include "tracer.h"
+#include"advtrac.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Old variables dimensions (from file)
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nsoilold,nqold
+
+c et autres:
+c----------
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+!      INTEGER sizei,
+      integer timelen,dimid
+!      INTEGER length
+!      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+!      CHARACTER*120 dimsource
+!      CHARACTER*16 dimname
+!      CHARACTER*80 dimtitle
+!      CHARACTER*40 dimunits
+!      INTEGER   dimtype
+
+!      INTEGER dimord(4)  ! tableau contenant l''ordre
+!      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+!      INTEGER vardim(4)
+      REAL date
+      INTEGER   memo
+!      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqmx),qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+!      integer klatdat,klongdat
+!      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx) ! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+      REAL co2ice(ngridmx) ! CO2 ice layer
+      REAL emis(ngridmx)
+      REAL q2(ngridmx,nlayermx+1),qsurf(ngridmx,nqmx)
+c     REAL phisfi(ngridmx)
+
+      INTEGER i,j,l
+      INTEGER nid,nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2),tauvis
+c     REAL iceradius(2) , dtemisice(2)
+
+!      EXTERNAL RAN1
+!      REAL RAN1
+!      EXTERNAL geopot,inigeom
+      integer ierr
+!      integer ismin
+!      external ismin
+!      CHARACTER*80 datapath
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      REAL phisold_newgrid(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real inertiedatS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqmx)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:), allocatable :: mlayerold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:,:),allocatable :: tsoiloldnew
+! tsoiloldnew: old soil values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatold
+! inertiedatoldnew: old inertia values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatoldnew
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold,tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+      logical :: olddepthdef=.false. ! flag
+! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
+      logical :: depthinterpol=.false. ! flag
+! depthinterpol=.true. if interpolation will be requiered
+      logical :: therminertia_3D=.true. ! flag
+! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+      real, dimension(:), allocatable :: oldgrid, oldval
+      real, dimension(:), allocatable :: newval
+!      real, dimension(:), allocatable :: oldmlayer
+
+      real surfith(iip1,jjp1) ! surface thermal inertia
+!      real surfithfi(ngridmx)
+      ! surface thermal inertia at old horizontal grid resolution
+      real, dimension(:,:), allocatable :: surfithold 
+
+! flag which identifies if archive file is using old tracer names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: counter
+      character(len=30) :: txt ! to store some text
+
+c=======================================================================
+
+! 0. Preliminary stuff
+
+! check if tracers follow old naming convention (q01, q02, q03, ...)
+      counter=0
+      do iq=1,nqmx
+        txt= " "
+        write(txt,'(a1,i2.2)')'q',iq
+        ierr=NF_INQ_VARID(nid,txt,nvarid)
+        if (ierr.ne.NF_NOERR) then
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          counter=counter+1
+        endif
+      enddo
+      if (counter.eq.nqmx) then
+        write(*,*) "lect_start_archive: tracers seem to follow old ",
+     &             "naming convention (q01, q02,...)"
+        oldtracernames=.true.
+      endif
+
+
+!-----------------------------------------------------------------------
+! 1. Read data dimensions (i.e. size and length)
+!-----------------------------------------------------------------------
+
+! 1.2 Read the various dimension lengths of data in file 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+! 1.2.1 find out the # of subsurface_layers
+      nsoilold=0 !dummy initialisation
+      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+      if (ierr.eq.NF_NOERR) then
+        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'lec_start_archive: ',
+     &              'Failed reading subsurface_layers length'
+	endif
+      else
+        write(*,*)"lec_start_archive: did not find subsurface_layers"
+      endif
+
+      if (nsoilold.eq.0) then ! 'old' archive format;
+      ! must use Tg//str2 fields to compute nsoilold
+      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
+        do
+	 write(str2,'(i2.2)') nsoilold+1
+	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
+	 if (ierr.eq.NF_NOERR) then
+	  nsoilold=nsoilold+1
+	 else
+	  exit
+	 endif
+	enddo
+      endif
+
+
+      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
+        depthinterpol=.true.
+      endif
+
+! 1.3 Report dimensions
+      
+      write(*,*) "Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      write(*,*) "tracers: ",nqold
+      write(*,*) "subsurface_layers: ",nsoilold
+      if (depthinterpol) then
+      write(*,*) " => Warning, nsoilmx= ",nsoilmx
+      write(*,*) '    which implies that you want subterranean interpola
+     &tion.'
+      write(*,*) '  Otherwise, set nsoilmx -in dimphys.h- to: ',nsoilold
+      endif
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+!-----------------------------------------------------------------------
+! 2. Allocate arrays to store datasets
+!-----------------------------------------------------------------------
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqmx))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(tsoilold(imold+1,jmold+1,nsoilold))
+      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
+      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
+      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
+      ! surface thermal inertia at old horizontal grid resolution
+      allocate(surfithold(imold+1,jmold+1))
+      allocate(mlayerold(nsoilold))
+      allocate(qsurfold(imold+1,jmold+1,nqmx))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngridmx,nlayermx+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+
+!-----------------------------------------------------------------------
+! 3. Read time-independent data
+!-----------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+c 3.1. Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c 3.2 Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
+         CALL abort
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c 3.3. Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <aps> est absent"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <bps> est absent"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
+         CALL abort
+      END IF
+
+c-----------------------------------------------------------------------
+c 3.4 Read Soil layers depths
+c-----------------------------------------------------------------------
+     
+      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <soildepth>'
+       write(*,*)' => Assuming this is an archive in old format'
+       olddepthdef=.true.
+       depthinterpol=.true.
+       ! this is how soil depth was defined in ye old days
+	do isoil=1,nsoilold
+	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
+	enddo
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+
+      endif !of if(ierr.ne.NF_NOERR)
+
+      ! Read (or build) mlayer()
+      if (depthinterpol) then
+       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
+       ! as in soil_settings.F
+       write(*,*)' => Building default soil depths'
+       do isoil=0,nsoilmx-1
+         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
+       enddo
+       write(*,*)' => mlayer: ',mlayer
+       ! Also build (default) new soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+       write(*,*)' =>  layer: ',layer
+      else ! read mlayer() from file
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+      endif ! of if (depthinterpol)
+
+c-----------------------------------------------------------------------
+c 3.5 Read Soil thermal inertia
+c-----------------------------------------------------------------------
+
+      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <inertiedat>'
+       write(*,*)' => Assuming this is an archive in old format'
+       therminertia_3D=.false.
+       write(*,*)' => Thermal inertia will be read from reference file'
+       volcapa=1.e6
+       write(*,*)'    and soil volumetric heat capacity is set to ',
+     &           volcapa
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
+         CALL abort
+       endif
+      endif
+
+c-----------------------------------------------------------------------
+c 3.6 Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c 4. Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Le champ <Time> est absent"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Differentes dates des etats initiaux stockes:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+        write(*,*) 'etat initial au jour martien' ,int(timelist(i))
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choix de la date'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+        if (date.eq.int(timelist(i))) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'He alors... Y sait pas lire !?!'
+        write(*,*)
+        write(*,*) 'Differentes dates des etats initiaux stockes:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+
+!-----------------------------------------------------------------------
+! 5. Read (time-dependent) data from datafile
+!-----------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
+         PRINT*, NF_STRERROR(ierr)
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <emis> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)"lect_start_archive: rlonuold:"
+     &           ,rlonuold," rlatvold:",rlatvold
+      write(*,*)
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Surface tracers:      
+      do iq=1,nqmx
+        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+      enddo
+
+      DO iq=1,nqmx
+!      iq=nqold
+!        write(str2,'(i2.2)') iq
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a5,i2.2)')'qsurf',iq
+        ELSE
+          txt=trim(tnom(iq))//"_surf"
+          if (txt.eq."h2o_vap") then
+            ! There is no surface tracer for h2o_vap;
+            ! "h2o_ice" should be loaded instead
+            txt="h2o_ice_surf"
+            write(*,*) 'lect_start_archive: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+          endif
+        ENDIF ! of IF (oldtracernames)
+        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+          CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#else
+        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             " Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'     set to 0'
+          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqmx
+
+! The trick below is to read in tracer nqmx-1 (i.e. water ice)
+!      if ((nqold.gt.1).and.(nqmx.gt.1)) then
+!        iq=nqold-1
+!        write(str2,'(i2.2)') iq
+!         ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Le champ <","qsurf"//str2,"> est absent"
+!            CALL abort
+!         ENDIF
+!#ifdef NC_DOUBLE
+!         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+!     .          qsurfold(1,1,nqmx-1))
+!#else
+!         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+!     .          qsurfold(1,1,nqmx-1))
+!#endif
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Lecture echouee pour <","qsurf"//str2,">"
+!            write (*,*) 'qsurf'//str2,' set to 0'
+!            call initial0((jmold+1)*(imold+1), qsurfold(1,1,nqmx-1))
+!         ENDIF
+!      endif
+
+! The trick below is to read in tracers except nqmx & nqmx-1 (water vap.& ice)
+!      if (nqold.gt.2) then
+!       do  iq = 1, nqold-2
+!       if (iq.lt.nqmx-1) then
+!         write(str2,'(i2.2)') iq
+!         ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Le champ <","qsurf"//str2,"> est absent"
+!            CALL abort
+!         ENDIF
+!#ifdef NC_DOUBLE
+!         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+!     .          qsurfold(1,1,iq))
+!#else
+!         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+!     .          qsurfold(1,1,iq))
+!#endif
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Lecture echouee pour <","qsurf"//str2,">"
+!            write (*,*) 'qsurf'//str2,' set to 0'
+!            call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+!         ENDIF
+!       end if
+!       end do
+!      end if
+
+!-----------------------------------------------------------------------
+! 5.2 Read 3D subterranean fields
+!-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+!
+! Read soil temperatures
+!
+      if (olddepthdef) then ! tsoil stored using the 'old format'
+         start=(/1,1,memo,0/)
+         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
+       do isoil=1,nsoilold
+!        write(*,*)'isoil',isoil
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              "Field <","Tg"//str2,"> not found"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &            "Failed reading <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+       enddo ! of do isoil=1,nsoilold
+      
+      ! reset 'start' and 'count' to "3D" behaviour
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+      
+      else
+       write(*,*) "lect_start_archive: loading tsoil "
+       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+       if (ierr.ne.NF_NOERR) then
+        write(*,*)"lect_start_archive: Cannot find <tsoil>"
+	call abort
+       else
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
+#endif
+       endif ! of if (ierr.ne.NF_NOERR)
+       
+      endif ! of if (olddepthdef)
+
+!
+! Read soil thermal inertias
+!
+!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
+!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
+!	call abort
+!       else
+!#ifdef NC_DOUBLE
+!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
+!#else
+!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
+!#endif
+!       endif ! of if (ierr.ne.NF_NOERR)
+!      endif
+
+c-----------------------------------------------------------------------
+c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,lmold,1/)
+
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <temp> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <u> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <v> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Tracers:      
+      do iq=1,nqmx
+         call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
+      enddo
+
+      DO iq=1,nqmx
+!      iq=nqold
+!        write(str2,'(i2.2)') iq
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a1,i2.2)')'q',iq
+        ELSE
+          txt=tnom(iq)
+        ENDIF
+        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+            CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+        ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             "  Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'      set to 1.E-30'
+          do l=1,lmold
+            do j=1,jmold+1
+              do i=1,imold+1
+                 qold(i,j,l,iq)=1.e-30
+              end do
+            end do
+          end do
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqmx
+
+! The trick below is to read in tracer nqmx-1 (i.e. water ice)
+!      if ((nqold.gt.1).and.(nqmx.gt.1)) then
+!        iq=nqold-1
+!        write(str2,'(i2.2)') iq
+!         ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive:
+!     .               Le champ <","q"//str2,"> est absent"
+!            CALL abort
+!         ENDIF
+!#ifdef NC_DOUBLE
+!         ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,
+!     .                            qold(1,1,1,nqmx-1))
+!#else
+!         ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,
+!     .                            qold(1,1,1,nqmx-1))
+!#endif
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Lecture echouee pour <","q"//str2,">"
+!            write (*,*) 'q'//str2,' set to 1.E-30'
+!            do l=1,lmold
+!              do j=1,jmold+1
+!                do i=1,imold+1
+!                   qold(1,1,1,nqmx-1)=1.e-30
+!                end do
+!              end do
+!            end do
+!
+!         ENDIF
+!      endif
+
+! The trick below is to read in tracers except nqmx & nqmx-1 (water vap.& ice)
+!      if (nqold.gt.2) then
+!       do  iq = 1, nqold-2
+!       if (iq.lt.nqmx-1) then
+!         write(str2,'(i2.2)') iq
+!         ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive:
+!     .               Le champ <","q"//str2,"> est absent"
+!            CALL abort
+!         ENDIF
+!#ifdef NC_DOUBLE
+!         ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+!#else
+!         ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+!#endif
+!         IF (ierr .NE. NF_NOERR) THEN
+!            PRINT*, "lect_start_archive: 
+!     .               Lecture echouee pour <","q"//str2,">"
+!            write (*,*) 'q'//str2,' set to 1.E-30 '
+!            do l=1,lmold
+!              do j=1,jmold+1
+!                do i=1,imold+1
+!                   qold(1,1,1,iq)=1.e-30
+!                end do
+!              end do
+!            end do
+
+!         ENDIF
+!       end if
+!       end do
+!      end if
+
+c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
+c -------------------------------------------------------------------------
+
+!      datapath = '/users/forget/gcm/data_mars_gcm'
+
+
+!=======================================================================
+! 6. Interpolation from old grid to new grid
+!=======================================================================
+
+c=======================================================================
+c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
+c=======================================================================
+c  Interpolation horizontale puis passage dans la grille physique pour 
+c  les variables physique 
+c  Interpolation verticale puis horizontale pour chaque variable 3D
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c 6.1	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Glace CO2
+      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tsurfs,tsurf)
+c     write(44,*) 'tsurf', tsurf
+
+c Temperature du sous-sol
+!      call interp_horiz(tsoilold,tsoils,
+!     &                  imold,jmold,iim,jjm,nsoilmx,
+!     &                   rlonuold,rlatvold,rlonu,rlatv)
+!      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,emiss,emis)
+c     write(46,*) 'emis',emis
+c-----------------------------------------------------------------------
+c 6.1.2	Traitement special de la pression au sol :
+c-----------------------------------------------------------------------
+
+c  Extrapolation la pression dans la nouvelle grille
+      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+         END DO
+      END DO
+
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de l atm :',ptotalold
+      write(*,*)'Nouvelle grille: masse de l atm :',ptotal
+      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold 
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
+      write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
+      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+         DO j=1,jjp1
+            DO i=1,iip1
+               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+            END DO
+         END DO
+      end if
+
+c-----------------------------------------------------------------------
+c 6.2 Subterranean 3d variables:
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c 6.2.1 Thermal Inertia
+c       Note: recall that inertiedat is a common in "comsoil.h"
+c-----------------------------------------------------------------------
+
+      ! depth-wise interpolation, if required
+      if (depthinterpol.and.(.not.olddepthdef)) then
+        allocate(oldval(nsoilold))
+	allocate(newval(nsoilmx))
+        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
+     &f soil thermal inertia; might be wiser to reset it.'
+        write(*,*)
+       
+        do i=1,imold+1
+         do j=1,jmold+1
+	   !copy old values
+	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
+	   !interpolate
+	   call interp_line(mlayerold,oldval,nsoilold,
+     &                     mlayer,newval,nsoilmx)
+           !copy interpolated values
+           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+        enddo
+        ! cleanup
+	deallocate(oldval)
+	deallocate(newval)
+      endif !of if (depthinterpol)
+
+      if (therminertia_3D) then
+        ! We have inertiedatold
+       if((imold.ne.iim).or.(jmold.ne.jjm)) then
+       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
+     &of thermal inertia; might be better to reset it.'
+       write(*,*)
+       endif
+       
+        ! Do horizontal interpolation
+	if (depthinterpol) then
+	  call interp_horiz(inertiedatoldnew,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+	else
+          call interp_horiz(inertiedatold,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilold,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+        endif ! of if (depthinterpol)
+
+      else ! no 3D thermal inertia data
+       write(*,*)'lect_start_archive: using reference surface inertia'
+        ! Use surface inertia (and extend it to all depths)
+        do i=1,nsoilmx
+         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
+        enddo
+	! Build an old resolution surface thermal inertia
+	! (will be needed for tsoil interpolation)
+	call interp_horiz(surfith,surfithold,
+     &                    iim,jjm,imold,jmold,1,
+     &                    rlonu,rlatv,rlonuold,rlatvold)
+      endif
+
+
+      ! Reshape inertiedatS to scalar grid as inertiedat
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,
+     &                  inertiedatS,inertiedat)
+      
+c-----------------------------------------------------------------------
+c 6.2.2 Soil temperature
+c-----------------------------------------------------------------------
+!      write(*,*) 'Soil'
+      ! Recast temperatures along soil depth, if necessary
+      if (olddepthdef) then
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	   ! build vertical coordinate
+	   oldgrid(1)=0. ! ground
+	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
+     &                (surfithold(i,j)/1.e6)
+          ! Note; at this stage, we impose volcapa=1.e6 above
+	  ! since volcapa isn't set in old soil definitions
+
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+
+      else
+       if (depthinterpol) then ! if vertical interpolation is required
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        ! build vertical coordinate
+	oldgrid(1)=0. ! ground
+	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+       
+       else
+        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
+       endif ! of if (depthinterpol)
+      endif ! of if (olddepthdef)
+
+      ! Do the horizontal interpolation
+       call interp_horiz(tsoiloldnew,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+      ! Reshape tsoilS to scalar grid as tsoil
+       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoilS,tsoil)
+
+
+
+c-----------------------------------------------------------------------
+c 6.3 Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngridmx,q2s,q2)
+      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call scal_wind(us,vs,unat,vnat)
+      write (*,*) 'lect_start_archive: unat ', unat (1,2,1)    ! INFO
+      do l=1,llm
+        do j = 1, jjp1
+          do i=1,iip1
+            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'lect_start_archive: ucov ', ucov (1,2,1)  ! INFO
+c     write(48,*) 'ucov',ucov
+      do l=1,llm
+        do j = 1, jjm
+          do i=1,iim
+            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
+c           vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+c traceurs surface
+      do iq = 1, nqmx
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqmx,iim+1,jjm+1,ngridmx,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqmx
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+c      iqmax=1
+c      
+c      if (nqold.gt.10) then
+c       do l=1,llm
+c        do j=1,jjp1
+c          do i=1,iip1
+c           do iq=1,nqold
+c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+c              iqmax=iq
+c            endif
+c           enddo
+c           q(i,j,l,iqmax)=1.
+c           qtot(i,j,l)=0
+c           do iq=1,nqold
+c            if (iq.ne.iqmax) then        
+c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+c            endif
+c           enddo !iq
+c           do iq=1,nqold
+c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+c           enddo !iq
+c          enddo !i   
+c         enddo !j   
+c       enddo !l  
+c      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqmx
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,co2ices,co2ice)
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(tsoiloldnew)
+      deallocate(inertiedatold)
+      deallocate(inertiedatoldnew)
+      deallocate(surfithold)
+      deallocate(mlayerold)
+      deallocate(qsurfold)
+      deallocate(var,varp1)
+
+!      write(*,*)'lect_start_archive: END'
+      return
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lectflux.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lectflux.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/lectflux.F	(revision 46)
@@ -0,0 +1,233 @@
+      SUBROUTINE lectflux(irec,massem,pbarun,pbarvn,wn,tetan,phin,
+     s     nrec,avant,airefi,
+     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf,
+     s     frac_impa,frac_nucl,phis)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom2.h"
+
+#include "tracstoke.h"
+
+      integer irec,nrec,i,j
+
+      integer ngridmx,ig,l
+      parameter (ngridmx=iim*(jjm-1)+2)
+      INTEGER nbsrf
+      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
+
+      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
+      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
+      real coefkz(ngridmx,llm)
+      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
+      real yu1(ngridmx), yv1(ngridmx)
+      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
+      integer imfu,imfd,ien_u,ide_u,
+     s      ien_d,ide_d,
+     s      icoefkz,izu1,izv1,
+     s      itsol,ipsf,
+     s      ilei, ilec
+      parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
+     s      ien_d=4*llm+1,ide_d=5*llm+1,
+     s      icoefkz=6*llm+1,
+     s      ilei=7*llm+1,ilec=8*llm+1,
+     s      izu1=9*llm+1,izv1=9*llm+2,
+     s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
+      logical avant
+
+      real massefi(ngridmx,llm)
+
+      real massem(ip1jmp1,llm),tetan(ip1jmp1,llm)
+      real pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
+      real pbarvst(iip1,jjp1,llm)
+      real wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
+      real phis(iip1,jjp1)
+
+      real airefi(ngridmx)
+
+      real xlecn(ngridmx,9*llm+2+2*nbsrf)
+
+      real zcontrole(ngridmx),zmass,tmpdyn(iip1,jjp1),zflux
+
+      real ziadvtrac,zrec,ziadvtrac2,zrec2
+      real zim,zjm,zlm,zklon,zklev
+
+      real zpi
+
+      zpi=2.*asin(1.)
+
+
+c==================================================================
+c   Si le numero du record est 0 alors: INITIALISATION
+c==================================================================
+c
+      print*,'ENTREE DANS LECTFLUX'
+        print*,'IREC=',IREC
+      if(irec.eq.0) then
+
+        print*,'IREC==',0
+
+C test         call inigeom
+
+c==================================================================
+c   ouverture des fichiers
+c==================================================================
+
+c   Fichier fluxmass
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
+#endif
+      open(47,file='fluxmass',form='unformatted',
+     s     access='direct'
+     s     ,recl=4*(6*ijp1llm))
+      read(47,rec=1) zrec,dtvr,ziadvtrac,zim,zjm,zlm,
+     s   rlonu,rlonv,rlatu,rlatv,aire
+     s    ,phis
+      print*,'zrec,dtvr,ziadvtrac,zim,zjm,zlm'
+      print*,zrec,dtvr,ziadvtrac,zim,zjm,zlm
+      print*,rlonv
+
+
+
+c  Fichier physique
+c  Fichier lessivage (supprime les donnees utiles sont dans "physique")
+#ifdef CRAY
+         CALL ASSIGN("assign -N ieee -F null f:physique")
+#endif
+      open(49,file='physique',form='unformatted',
+     s     access='direct'
+     s     ,recl=4*ngridmx*(9*llm+2+2*nbsrf))
+      read(49,rec=1) zrec2,ziadvtrac2,zklon,zklev
+      print*,'Entete du fichier physique'
+      print*,zrec2,ziadvtrac2,zklon,zklev
+
+      nrec=zrec
+      print*,'nrec=',nrec
+
+      istdyn=ziadvtrac
+      istphy=ziadvtrac2
+
+c==================================================================
+c   Fin des initialisations
+      else ! irec=0
+c==================================================================
+
+
+c-----------------------------------------------------------------------
+c   Lecture des fichiers fluxmass et  physique:
+c   -----------------------------------------------------
+
+c  Variables dynamiques
+         read(47,rec=irec) massem,pbarun,pbarvst,wn,tetan,phin
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvn(i,j,l)=pbarvst(i,j,l)
+              enddo
+           enddo
+        enddo
+
+c  Variables physiques
+         read(49,rec=irec) ((xlecn(ig,l),ig=1,ngridmx),
+     s                                    l=1,9*llm+2+2*nbsrf)
+
+       do l=1,llm
+          do ig=1,ngridmx
+             coefkz(ig,l)=xlecn(ig,icoefkz+l-1)
+             frac_impa(ig,l)=xlecn(ig,ilei+l-1)
+             frac_nucl(ig,l)=xlecn(ig,ilec+l-1)
+          enddo
+       enddo
+       do l=1,nbsrf
+          do ig=1,ngridmx
+             ftsol(ig,l)=xlecn(ig,itsol+l-1)
+             pctsrf(ig,l)=xlecn(ig,ipsf+l-1)
+          enddo
+       enddo
+       do ig=1,ngridmx
+          yv1(ig)=xlecn(ig,izv1)
+          yu1(ig)=xlecn(ig,izu1)
+       enddo
+C
+      if(avant) then
+c   Simu directe
+       do l=1,llm
+          do ig=1,ngridmx
+             zmfu(ig,l)=xlecn(ig,imfu+l-1)
+             zmfd(ig,l)=xlecn(ig,imfd+l-1)
+             zde_u(ig,l)=xlecn(ig,ide_u+l-1)
+             zen_u(ig,l)=xlecn(ig,ien_u+l-1)
+             zde_d(ig,l)=xlecn(ig,ide_d+l-1)
+             zen_d(ig,l)=xlecn(ig,ien_d+l-1)
+          enddo
+       enddo
+      else
+c   Simu retro
+       do l=1,llm
+          do ig=1,ngridmx
+             zmfd(ig,l)=-xlecn(ig,imfu+l-1)
+             zmfu(ig,l)=-xlecn(ig,imfd+l-1)
+             zen_d(ig,l)=xlecn(ig,ide_u+l-1)
+             zde_d(ig,l)=xlecn(ig,ien_u+l-1)
+             zen_u(ig,l)=xlecn(ig,ide_d+l-1)
+             zde_u(ig,l)=xlecn(ig,ien_d+l-1)
+          enddo
+       enddo
+      endif
+
+c-----------------------------------------------------------------------
+c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
+c-----------------------------------------------------------------------
+
+      print*,'Ap redec irec'
+
+         call gr_dyn_fi(llm,iip1,jjp1,ngridmx,massem,massefi)
+
+         do ig=1,ngridmx
+            zcontrole(ig)=1.
+         enddo
+c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
+         do l=2,llm
+            do ig=1,ngridmx
+               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
+               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
+               if(zflux.gt.0.9*zmass) then
+                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
+               endif
+            enddo
+         enddo
+
+         do ig=1,ngridmx
+            if(zcontrole(ig).lt.0.99999) then
+               print*,'ATTENTION !!! on reduit les flux de masse '
+               print*,'convectifs au point ig=',ig
+            endif
+         enddo
+
+         call gr_fi_dyn(1,ngridmx,iip1,jjp1,zcontrole,tmpdyn)
+
+         do l=1,llm
+            do ig=1,ngridmx
+               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
+               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
+               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
+               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
+               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
+               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
+            enddo
+         enddo
+
+
+      endif ! irec=0
+
+
+      RETURN
+      END
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbar.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbar.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbar.F	(revision 46)
@@ -0,0 +1,97 @@
+      SUBROUTINE massbar(  masse, massebx, masseby )
+c
+c **********************************************************************
+c
+c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
+c **********************************************************************
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
+c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
+c     
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
+     *      masseby(   ip1jm,llm )
+c
+c
+c   Methode pour calculer massebx et masseby .
+c   ----------------------------------------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c                       On  a :
+c
+c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
+c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
+c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c
+c=======================================================================
+
+      DO   100    l = 1 , llm
+c
+        DO  ij = 1, ip1jmp1 - 1
+         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     + 
+     *                   masse(ij+1, l) * alpha3p4(ij+1 )
+        ENDDO
+
+c    .... correction pour massebx( iip1,j) .....
+c    ...    massebx(iip1,j)= massebx(1,j) ...
+c
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jmp1, iip1
+         massebx( ij,l ) = massebx( ij - iim,l )
+        ENDDO
+
+
+         DO  ij = 1,ip1jm
+         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
+     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
+         ENDDO
+
+100   CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbarxy.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbarxy.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massbarxy.F	(revision 46)
@@ -0,0 +1,44 @@
+      SUBROUTINE massbarxy(  masse, massebxy )
+c
+c **********************************************************************
+c
+c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
+c **********************************************************************
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
+c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
+c     
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
+c
+
+      DO l = 1 , llm
+c
+         DO ij = 1, ip1jm - 1
+            massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    ) +
+     +                      masse(   ij+1 ,l ) * alpha3(  ij+1   ) +
+     +                      masse( ij+iip1,l ) * alpha1( ij+iip1 ) +
+     +                      masse( ij+iip2,l ) * alpha4( ij+iip2 )
+         ENDDO
+
+c    ....  correction pour     massebxy( iip1,j )  ........
+
+CDIR$ IVDEP
+
+         DO ij = iip1, ip1jm, iip1
+            massebxy( ij,l ) = massebxy( ij - iim,l )
+         ENDDO
+
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massdair.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massdair.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/massdair.F	(revision 46)
@@ -0,0 +1,107 @@
+      SUBROUTINE massdair( p, masse )
+c
+c *********************************************************************
+c       ....  Calcule la masse d'air  dans chaque maille   ....
+c *********************************************************************
+c
+c    Auteurs : P. Le Van , Fr. Hourdin  .
+c   ..........
+c
+c  ..    p                      est  un argum. d'entree pour le s-pg ...
+c  ..  masse                    est un  argum.de sortie pour le s-pg ...
+c     
+c  ....  p est defini aux interfaces des llm couches   .....
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c  .....   arguments  ....
+c
+      REAL p(ip1jmp1,llmp1), masse(ip1jmp1,llm)
+
+c   ....  Variables locales  .....
+
+      INTEGER l,ij
+      REAL massemoyn, massemoys
+
+      REAL SSUM
+      EXTERNAL SSUM
+c
+c
+c   Methode pour calculer massebx et masseby .
+c   ----------------------------------------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c                       On  a :
+c
+c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
+c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
+c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c
+c=======================================================================
+
+      DO   100    l = 1 , llm
+c
+        DO    ij     = 1, ip1jmp1
+         masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
+        ENDDO
+c
+        DO   ij = 1, ip1jmp1,iip1
+         masse(ij+ iim,l) = masse(ij,l)
+        ENDDO
+c
+c       DO    ij     = 1,  iim
+c        masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )
+c        masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm) 
+c       ENDDO
+c        massemoyn         = SSUM(iim,masse(   1   ,l),1)/ apoln
+c        massemoys         = SSUM(iim,masse(ip1jm+1,l),1)/ apols
+c       DO    ij     = 1, iip1
+c        masse(   ij   ,l )    = massemoyn
+c        masse(ij+ip1jm,l )    = massemoys
+c       ENDDO
+       
+100   CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/minmax.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/minmax.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/minmax.F	(revision 46)
@@ -0,0 +1,20 @@
+       SUBROUTINE minmax(imax, xi, zmin, zmax )
+c
+c      P. Le Van
+
+       INTEGER imax
+       REAL    xi(imax)
+       REAL    zmin,zmax
+       INTEGER i
+
+       zmin = xi(1)
+       zmax = xi(1)
+
+       DO i = 2, imax
+         zmin = MIN( zmin,xi(i) )
+         zmax = MAX( zmax,xi(i) )
+       ENDDO
+
+       RETURN
+       END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multipl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multipl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multipl.F	(revision 46)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multscal.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multscal.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/multscal.F	(revision 46)
@@ -0,0 +1,9 @@
+      SUBROUTINE multscal(n,x,lambda,y)
+      IMPLICIT NONE
+      INTEGER i,n
+      REAL lambda,x(n),y(n)
+      DO 10 i=1,n
+         y(i)=x(i)*lambda
+10    CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/newstart.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/newstart.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/newstart.F	(revision 46)
@@ -0,0 +1,1507 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "control.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "lmdstd.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+#include "serre.h"
+#include "netcdf.inc"
+#include"advtrac.h"
+#include"tracer.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+c et autres:
+c----------
+      INTEGER lnblnk
+      EXTERNAL lnblnk
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+!      INTEGER size
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER   NB_ETATMAX
+      parameter (NB_ETATMAX = 100)
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqmx)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx)	! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL emis(ngridmx)	! surface emissivity
+      REAL qsurf(ngridmx,nqmx)
+      REAL q2(ngridmx,nlayermx+1)
+!      REAL rnaturfi(ngridmx)
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      EXTERNAL iniconst,geopot,inigeom
+      integer ierr  !, nbetat
+      integer ismin
+      external ismin
+
+c Variables on the new grid along scalar points 
+c------------------------------------------------------
+!      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+!      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1
+      character*80      fichnom
+      integer Lmodif,iq,thermo
+      character modif*20
+      real z_reel(iip1,jjp1)
+      real tsud,albsud,alb_bb,ith_bb,Tiso
+      real ptoto,pcap,patm,airetot,ptotn,patmn
+!      real ssum
+      character*1 yes
+      logical :: flagiso=.false. ,  flagps0=.false.
+      real val, val2, val3 ! to store temporary variables
+      real :: iceith=2000 ! thermal inertia of subterranean ice
+      integer iref,jref
+
+      INTEGER :: itau
+      
+      INTEGER :: nq,numvanle
+      character(len=20) :: txt ! to store some text
+      integer :: count
+
+! MONS data:
+      real :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! coefficient to apply to convert d21 to 'true' depth (m)
+      real :: MONS_coeff
+      real :: MONS_coeffS ! coeff for southern hemisphere
+      real :: MONS_coeffN ! coeff for northern hemisphere
+!      real,parameter :: icedepthmin=1.e-3 ! Ice begins at most at that depth
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+!      INTEGER :: visuid
+!      real :: time_step,t_ops,t_wrt
+!      CHARACTER*80 :: visu_file
+
+      cpp    = 744.499 ! for Mars, instead of 1004.70885 (Earth)
+      preff  = 610.    ! for Mars, instead of 101325. (Earth)
+      pa= 20           ! for Mars, instead of 500 (Earth)
+
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'reading tab_cntrl START_ARCHIVE'
+c
+        ierr = NF_INQ_VARID (nid, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+c
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'reading tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'reading tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+      write(*,*) 'printing tab_cntrl', tab_cntrl
+      do i=1,100
+        write(*,*) i,tab_cntrl(i)
+      enddo
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      mugaz = p_mugaz
+      daysec = p_daysec
+!      write(*,*) 'aire',aire
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+! Load tracer names:
+      call iniadvtrac(nq,numvanle)
+
+      day_step=180 !?! Note: day_step is a common in "control.h"
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
+!       rlatu() and rlonv() are given in radians
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
+                              ! surface.dat dans le cas des start
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+      CALL datareadnc(relief,phis,alb,surfith,zmeaS,zstdS,zsigS,zgamS,
+     .          ztheS)
+
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+!      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif ! of if (choix_1.ne.1)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Reading file START_ARCHIVE'
+        CALL lect_start_archive(date,tsurf,tsoil,emis,q2,
+     .   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,
+     &   surfith,nid)
+        write(*,*) "OK, read start_archive file"
+	! copy soil thermal inertia
+	ithfi(:,:)=inertiedat(:,:)
+	
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
+                                  !  permet de changer les valeurs du 
+                                  !  tab_cntrl Lmodif=1
+        tab0=0
+        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+        write(*,*) 'Reading file START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqmx,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'Reading file STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,nqmx,
+     .        day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,co2ice)
+        
+        ! copy albedo and soil thermal inertia
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+	  do j=1,nsoilmx
+           ithfi(i,j) = inertiedat(i,j)
+	  enddo
+        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
+        ! be neede later on if reinitializing soil thermal inertia
+          surfithfi(i)=ithfi(i,1)
+        enddo
+
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/FLOAT(day_step)
+      dtphys   = dtvr * FLOAT(iphysiq)
+
+c=======================================================================
+c 
+c=======================================================================
+! If tracer names follow 'old' convention (q01, q02, ...) then
+! rename them
+      count=0
+      do iq=1,nqmx
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tnom(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+      
+      if (count.eq.nqmx) then
+        write(*,*) 'Newstart: updating tracer names'
+        ! do things the easy but dirty way:
+        ! 1. call inichim_readcallphys (so that callphys.def is read)
+        call inichim_readcallphys()
+        ! 2. call initracer to set all new tracer names (in noms(:)) 
+        call initracer(qsurf,co2ice)
+        ! 3. copy noms(:) to tnom(:)
+        tnom(1:nqmx)=noms(1:nqmx)
+        write(*,*) 'Newstart: updated tracer names'
+      endif
+
+c=======================================================================
+c 
+c=======================================================================
+
+      do ! infinite loop on list of changes
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'List of possible changes :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat : no topography ("aquaplanet")'
+      write(*,*) 'bilball : uniform albedo and thermal inertia'
+      write(*,*) 'coldspole : cold subsurface and high albedo at S.pole'
+      write(*,*) 'qname : change tracer name'
+      write(*,*) 'q=0 : ALL tracer =zero'
+      write(*,*) 'q=x : give a specific uniform value to one tracer'
+      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
+     $d ice   '
+      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
+     $ice '
+      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
+     $ly '
+      write(*,*) 'noglacier : Remove tropical H2O ice if |lat|<45'
+      write(*,*) 'watercapn : H20 ice on permanent N polar cap '
+      write(*,*) 'watercaps : H20 ice on permanent S polar cap '
+      write(*,*) 'wetstart  : start with a wet atmosphere'
+      write(*,*) 'isotherm : Isothermal Temperatures, wind set to zero'
+      write(*,*) 'co2ice=0 : remove CO2 polar cap'
+      write(*,*) 'ptot : change total pressure'
+      write(*,*) 'therm_ini_s: Set soil thermal inertia to reference sur
+     &face values'
+      write(*,*) 'subsoilice_n: Put deep underground ice layer in northe
+     &rn hemisphere'
+      write(*,*) 'subsoilice_s: Put deep underground ice layer in southe
+     &rn hemisphere'
+      write(*,*) 'mons_ice: Put underground ice layer according to MONS-
+     &derived data'
+
+        write(*,*)
+        write(*,*) 'Change to perform ?'
+        write(*,*) '   (enter keyword or return to end)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') exit ! exit loop on changes
+
+        write(*,*)
+        write(*,*) modif(1:lnblnk(modif)) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (modif(1:lnblnk(modif)) .eq. 'flat') then
+c         set topo to zero 
+          CALL initial0(ip1jmp1,z_reel)
+          CALL multscal(ip1jmp1,z_reel,g,phis)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+
+c        Choice for surface pressure
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to choose homogeneous surface',
+     &                 'pressure (y) or let newstart interpolate ',
+     &                 ' the previous field  (n)?'
+             read(*,fmt='(a)') yes
+         end do
+         if (yes.eq.'y') then
+           flagps0=.true.
+           write(*,*) 'New value for ps (Pa) ?'
+ 201       read(*,*,iostat=ierr) patm
+            if(ierr.ne.0) goto 201
+             write(*,*)
+             write(*,*) ' new ps everywhere (Pa) = ', patm
+             write(*,*)
+             do j=1,jjp1
+               do i=1,iip1
+                 ps(i,j)=patm
+               enddo
+             enddo
+         end if
+
+c       bilball : albedo, inertie thermique uniforme
+c       --------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'bilball') then
+          write(*,*) 'constante albedo and iner.therm:'
+          write(*,*) 'New value for albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' uniform albedo (new value):',alb_bb
+          write(*,*)
+
+          write(*,*) 'New value for thermal inertia (eg: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'uniform thermal inertia (new value):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb	! albedo
+		do isoil=1,nsoilmx
+                  ith(i,j,isoil) = ith_bb	! thermal inertia
+		enddo
+             END DO
+          END DO
+!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'coldspole') then
+          write(*,*)'new value for the subsurface temperature',
+     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' new value of the subsurface temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'new value for the albedo',
+     &   'of the permanent southern polar cap ? (eg: 0.75)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  only the albedo of the pole is modified :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification of the total pressure: ice + current atmosphere 
+c       -------------------------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ptot') then
+
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                pcap = pcap + aire(i,j)*co2ice(ig)*g
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Current total pressure at surface (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'new value?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Mult. factor for pressure (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqmx
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c       qname : change tracer name
+c       --------------------------
+        else if (trim(modif).eq.'qname') then
+         yes='y'
+         do while (yes.eq.'y')
+          write(*,*) 'Which tracer name do you want to change ?'
+          do iq=1,nqmx
+            write(*,'(i3,a3,a20)')iq,' : ',trim(tnom(iq))
+          enddo
+          write(*,'(a35,i3)')
+     &            '(enter tracer number; between 1 and ',nqmx
+          write(*,*)' or any other value to quit this option)'
+          read(*,*) iq
+          if ((iq.ge.1).and.(iq.le.nqmx)) then
+            write(*,*)'Change tracer name ',trim(tnom(iq)),' to ?'
+            read(*,*) txt
+            tnom(iq)=txt
+            write(*,*)'Do you want to change another tracer name (y/n)?'
+            read(*,'(a)') yes 
+          else
+! inapropiate value of iq; quit this option
+            yes='n'
+          endif ! of if ((iq.ge.1).and.(iq.le.nqmx))
+         enddo ! of do while (yes.ne.'y')
+
+c       q=0 : set tracers to zero
+c       -------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
+           DO iq =1, nqmx
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          set surface tracers to zero
+           DO iq =1, nqmx
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             do iq=1,nqmx
+               write(*,*)iq,' : ',trim(tnom(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqmx,')'
+             read(*,*) iq 
+             write(*,*)'mixing ratio of tracer ',trim(tnom(iq)),
+     &                 ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer ',trim(tnom(iq)),
+     &                   ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       ini_q : Initialize tracers for chemistry
+c       -----------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q') then
+c         For more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if (llm.gt.32) then 
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &     'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo  
+          endif
+          
+              call inichim_newstart(q,ps,sig,nqmx,latfi,lonfi,airefi,
+     $   thermo,qsurf)
+          write(*,*) 'Chemical species initialized'
+
+        if (thermo.eq.0) then 
+c          mise a 0 des qsurf (traceurs a la surface)
+           DO iq =1, nqmx
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+        endif   
+
+c       ini_q-H2O : as above exept for the water vapour tracer 
+c       ------------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q-H2O') then
+          ! for more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo
+          endif
+              call inichim_newstart(q,ps,sig,nqmx-1,latfi,lonfi,airefi,
+     $   thermo,qsurf)
+          write(*,*) 'Initialized chem. species exept last (H2O)'
+
+        if (thermo.eq.0) then 
+c          set surface tracers to zero, except water ice
+           DO iq =1, nqmx
+            if (iq.ne.igcm_h2o_ice) then
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+            endif
+           ENDDO
+        endif
+
+c       ini_q-iceH2O : as above exept for ice et H2O
+c       -----------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'ini_q-iceH2O') then
+c         For more than 32 layers, possible to initiate thermosphere only     
+          thermo=0
+          yes=' '
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            thermo=1 
+            else
+            thermo=0
+            endif
+            enddo
+          endif
+     
+         call inichim_newstart(q,ps,sig,nqmx-2,latfi,lonfi,airefi,
+     $   thermo,qsurf)
+          write(*,*) 'Initialized chem. species exept ice and H2O'
+
+        if (thermo.eq.0) then 
+c          set surface tracers to zero, except water ice
+           DO iq =1, nqmx
+            if (iq.ne.igcm_h2o_ice) then
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO 
+            endif
+           ENDDO
+        endif
+
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (modif(1:lnblnk(modif)) .eq. 'wetstart') then
+        ! check that there is indeed a water vapor tracer
+        if (igcm_h2o_vap.eq.0) then
+          write(*,*) "No water vapour tracer! Can't use this option"
+          stop
+        endif
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1
+                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,igcm_h2o_vap)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,igcm_h2o_vap)
+
+c      noglacier : remove tropical water ice (to initialize high res sim)
+c      --------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'noglacier') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              write(*,*) 'OK: remove surface ice for |lat|<45'
+              if (abs(rlatu(j)*180./pi).lt.45.) then
+                   qsurf(ig,igcm_h2o_ice)=0.
+              end if
+           end do
+
+
+c      watercapn : H20 ice on permanent northern cap
+c      --------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'watercapn') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              if (rlatu(j)*180./pi.gt.80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &              rlatv(j)*180./pi
+                end if
+           enddo
+
+c      watercaps : H20 ice on permanent southern cap
+c      -------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'watercaps') then
+           do ig=1,ngridmx
+               j=(ig-2)/iim +2
+               if(ig.eq.1) j=1
+               if (rlatu(j)*180./pi.lt.-80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &              rlatv(j-1)*180./pi
+               end if
+           enddo
+
+c       isotherm : Isothermal temperatures and no winds
+c       ------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of this temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          do ig=1, ngridmx
+            tsurf(ig) = Tiso
+          end do
+          do l=2,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = Tiso
+            end do
+          end do
+          flagiso=.true.
+          call initial0(llm*ip1jmp1,ucov)
+          call initial0(llm*ip1jm,vcov)
+          call initial0(ngridmx*(llm+1),q2)
+
+c       co2ice=0 : remove CO2 polar ice caps'
+c       ------------------------------------------------
+        else if (modif(1:lnblnk(modif)) .eq. 'co2ice=0') then
+           do ig=1,ngridmx
+              co2ice(ig)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+        
+!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
+!       ----------------------------------------------------------------------
+
+	else if (modif(1:lnblnk(modif)).eq.'therm_ini_s') then
+!          write(*,*)"surfithfi(1):",surfithfi(1)
+	  do isoil=1,nsoilmx
+	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+	  enddo
+          write(*,*)'OK: Soil thermal inertia has been reset to referenc
+     &e surface values'
+!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
+	  ithfi(:,:)=inertiedat(:,:)
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+!       subsoilice_n: Put deep ice layer in northern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (modif(1:lnblnk(modif)).eq.'subsoilice_n') then
+
+         write(*,*)'From which latitude (in deg.), up to the north pole,
+     &should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.lt.0.).or.(val.gt.90)) then
+	      write(*,*)'Latitude should be between 0 and 90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+!	 if (val2.lt.layer(1)) then
+!	  iref=1
+!	 else
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+!	 endif
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+!	 write(*,*)'layer',layer
+!	 write(*,*)'mlayer',mlayer
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=1,jref
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=1,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+!         do i=1,nsoilmx
+!	  write(*,*)'i:',i,'ithfi(1,i):',ithfi(1,i)
+!	 enddo
+
+	
+!       subsoilice_s: Put deep ice layer in southern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (modif(1:lnblnk(modif)).eq.'subsoilice_s') then
+
+         write(*,*)'From which latitude (in deg.), down to the south pol
+     &e, should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.gt.0.).or.(val.lt.-90)) then
+	      write(*,*)'Latitude should be between 0 and -90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=jref,jjp1
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=jref,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c       'mons_ice' : use MONS data to build subsurface ice table
+c       --------------------------------------------------------
+        else if (modif(1:lnblnk(modif)).eq.'mons_ice') then
+        
+       ! 1. Load MONS data
+        call load_MONS_data(MONS_Hdn,MONS_d21)
+        
+        ! 2. Get parameters from user
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Northern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffN
+        enddo
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Southern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffS
+        enddo
+        ierr=1
+        do while (ierr.ne.0)
+          write(*,*) "Value of subterranean ice thermal inertia?"
+          write(*,*) " (e.g.: 2000, or perhaps 2290)"
+          read(*,*,iostat=ierr) iceith
+        enddo
+        
+        ! 3. Build subterranean thermal inertia
+        
+        ! initialise subsurface inertia with reference surface values
+        do isoil=1,nsoilmx
+          ithfi(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+        enddo
+        ! recast ithfi() onto ith()
+	call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+        
+        do i=1,iip1 ! loop on longitudes
+          do j=1,jjp1 ! loop on latitudes
+            ! set MONS_coeff
+            if (rlatu(j).ge.0) then ! northern hemisphere
+              ! N.B: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+              MONS_coeff=MONS_coeffN
+            else ! southern hemisphere
+              MONS_coeff=MONS_coeffS
+            endif
+            ! check if we should put subterranean ice
+            if (MONS_Hdn(i,j).ge.14.0) then ! no ice if Hdn<14%
+              ! compute depth at which ice lies:
+              val=MONS_d21(i,j)*MONS_coeff
+              ! compute val2= the diurnal skin depth of surface inertia
+              ! assuming a volumetric heat cap. of C=1.e6 J.m-3.K-1
+              val2=ith(i,j,1)*1.e-6*sqrt(88775./3.14159)
+              if (val.lt.val2) then
+                ! ice must be below the (surface inertia) diurnal skin depth
+                val=val2
+              endif
+              if (val.lt.layer(nsoilmx)) then ! subterranean ice
+                ! find the reference index iref that depth corresponds to
+                iref=0
+                do isoil=1,nsoilmx-1
+                 if ((val.ge.layer(isoil)).and.(val.lt.layer(isoil+1)))
+     &             then
+	           iref=isoil
+	           exit
+	         endif
+                enddo
+                ! Build "equivalent" thermal inertia for the mixed layer
+                ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val-layer(iref))/(ith(i,j,iref+1)**2))+
+     &                      ((layer(iref+1)-val)/(iceith)**2)))
+	        ! Set thermal inertia of lower layers
+                do isoil=iref+2,nsoilmx
+                  ith(i,j,isoil)=iceith 
+                enddo
+              endif ! of if (val.lt.layer(nsoilmx))
+            endif ! of if (MONS_Hdn(i,j).lt.14.0)
+          enddo ! do j=1,jjp1
+        enddo ! do i=1,iip1
+        
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+        ! recast ith() into ithfi()
+        CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+        
+	else
+          write(*,*) '       Unknown (misspelled?) option!!!'
+        end if ! of if (modif(1:lnblnk(modif)) .eq. '...') elseif ...
+	
+       enddo ! of do ! infinite loop on liste of changes
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Correct pressure on the new grid (menu 0)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) * 
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+  
+c periodicity of surface ps in longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagiso) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
+     *                tetagdiv, tetagrot , tetatemp  )
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+c     CALL caldyn
+c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
+
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqmx)
+      CALL dynredem1("restart.nc",0.0,vcov,ucov,teta,q,nqmx,masse,ps) 
+C
+C Ecriture etat initial physique
+C
+
+      call physdem1("restartfi.nc",lonfi,latfi,nsoilmx,nqmx,
+     .              dtphys,float(day_ini),
+     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      end
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine load_MONS_data(MONS_Hdn,MONS_d21)
+      implicit none
+      ! routine to load Benedicte Diez MONS dataset, fill in date in southern
+      ! polar region, and interpolate the result onto the GCM grid
+#include"dimensions.h"
+#include"paramet.h"
+#include"datafile.h"
+#include"comgeom.h"
+      ! arguments:
+      real,intent(out) :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real,intent(out) :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! N.B MONS datasets should be of dimension (iip1,jjp1)
+      ! local variables:
+      character(len=88) :: filename="results_MONS_lat_lon_H_depth.txt"
+      character(len=88) :: txt ! to store some text
+      integer :: ierr,i,j
+      integer,parameter :: nblon=180 ! number of longitudes of MONS datasets
+      integer,parameter :: nblat=90 ! number of latitudes of MONS datasets
+      real :: pi
+      real :: longitudes(nblon) ! MONS dataset longitudes
+      real :: latitudes(nblat)  ! MONS dataset latitudes
+      ! MONS dataset: mass fraction of H2O where H is assumed to be in H2O
+      real :: Hdn(nblon,nblat)
+      real :: d21(nblon,nblat)! MONS dataset "depth" (g/cm2)
+
+      ! Extended MONS dataset (for interp_horiz)
+      real :: Hdnx(nblon+1,nblat)
+      real :: d21x(nblon+1,nblat)
+      real :: lon_bound(nblon+1) ! longitude boundaries
+      real :: lat_bound(nblat-1) ! latitude boundaries
+
+      ! 1. Initializations:
+
+      write(*,*) "Loading MONS data"
+
+      ! Open MONS datafile:
+      open(42,file=trim(datafile)//"/"//trim(filename),
+     &     status="old",iostat=ierr)
+      if (ierr/=0) then
+        write(*,*) "Error in load_MONS_data:"
+        write(*,*) "Failed opening file ",
+     &             trim(datafile)//"/"//trim(filename)
+        write(*,*)'1) You can change the path to the file in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary ',trim(filename),
+     &                 ' (and other datafiles)'
+        write(*,*)'   can be obtained online at:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        CALL ABORT
+      else ! skip first line of file (dummy read)
+         read(42,*) txt
+      endif
+
+      pi=2.*asin(1.)
+      
+      !2. Load MONS data (on MONS grid)
+      do j=1,nblat
+        do i=1,nblon
+        ! swap latitude index so latitudes go from north pole to south pole:
+          read(42,*) latitudes(nblat-j+1),longitudes(i),
+     &               Hdn(i,nblat-j+1),d21(i,nblat-j+1)
+        ! multiply d21 by 10 to convert from g/cm2 to kg/m2
+          d21(i,nblat-j+1)=d21(i,nblat-j+1)*10.0
+        enddo
+      enddo
+      close(42)
+      
+      ! there is unfortunately no d21 data for latitudes -77 to -90
+      ! so we build some by linear interpolation between values at -75
+      ! and assuming d21=0 at the pole
+      do j=84,90 ! latitudes(84)=-77 ; latitudes(83)=-75
+        do i=1,nblon
+          d21(i,j)=d21(i,83)*((latitudes(j)+90)/15.0)
+        enddo
+      enddo
+
+      ! 3. Build extended MONS dataset & boundaries (for interp_horiz)
+      ! longitude boundaries (in radians):
+      do i=1,nblon
+        ! NB: MONS data is every 2 degrees in longitude
+        lon_bound(i)=(longitudes(i)+1.0)*pi/180.0
+      enddo
+      ! extra 'modulo' value
+      lon_bound(nblon+1)=lon_bound(1)+2.0*pi
+      
+      ! latitude boundaries (in radians):
+      do j=1,nblat-1
+        ! NB: Mons data is every 2 degrees in latitude
+        lat_bound(j)=(latitudes(j)-1.0)*pi/180.0
+      enddo
+      
+      ! MONS datasets:
+      do j=1,nblat
+        Hdnx(1:nblon,j)=Hdn(1:nblon,j)
+        Hdnx(nblon+1,j)=Hdnx(1,j)
+        d21x(1:nblon,j)=d21(1:nblon,j)
+        d21x(nblon+1,j)=d21x(1,j)
+      enddo
+      
+      ! Interpolate onto GCM grid
+      call interp_horiz(Hdnx,MONS_Hdn,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      call interp_horiz(d21x,MONS_d21,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      
+      end subroutine
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad.F	(revision 46)
@@ -0,0 +1,45 @@
+      SUBROUTINE nxgrad (klevel, rot, x, y )
+c
+c     P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER   l,ij
+c
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+CDIR$ IVDEP
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad_gam.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad_gam.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrad_gam.F	(revision 46)
@@ -0,0 +1,46 @@
+      SUBROUTINE nxgrad_gam( klevel, rot, x, y )
+c
+c  P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER   l,ij
+      integer ismin,ismax
+      external ismin,ismax
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+CDIR$ IVDEP
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgradst.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgradst.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgradst.F	(revision 46)
@@ -0,0 +1,44 @@
+      SUBROUTINE nxgradst (klevel,rot, x, y )
+c
+      IMPLICIT NONE
+c     Auteur :  P. Le Van
+c
+c   ********************************************************************
+c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
+c   ********************************************************************
+c       rot          est un argument  d'entree pour le s-prog
+c       x  et y    sont des arguments de sortie pour le s-prog
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
+      INTEGER l,ij
+c
+      DO 10 l = 1,klevel
+c
+      DO 1  ij = 2, ip1jm
+      y(ij,l)=( rot(ij,l) - rot(ij-1,l))
+   1  CONTINUE
+c
+c    ..... correction pour  y ( 1,j,l )  ......
+c
+c    ....    y(1,j,l)= y(iip1,j,l) ....
+
+      DO 2  ij = 1, ip1jm, iip1
+      y( ij,l ) = y( ij +iim,l )
+   2  CONTINUE
+c
+      DO 4  ij = iip2,ip1jm
+      x(ij,l)= rot(ij,l)-rot(ij-iip1,l)
+   4  CONTINUE
+      DO 6 ij = 1,iip1
+      x(    ij    ,l ) = 0.
+      x( ij +ip1jm,l ) = 0.
+   6  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgraro2.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgraro2.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgraro2.F	(revision 46)
@@ -0,0 +1,67 @@
+       SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
+c
+c      P.Le Van .
+c   ***********************************************************
+c                                 lr
+c      calcul de  ( nxgrad (rot) )   du vect. v  ....
+c
+c       xcov et ycov  etant les compos. covariantes de  v
+c   ***********************************************************
+c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
+c      grx   et  gry     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+c
+c    ......  variables en arguments  .......
+c
+      INTEGER klevel
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
+c
+c    ......   variables locales     ........
+c
+      REAL rot(ip1jm,llm) , signe, nugradrs
+      INTEGER l,ij,iter,lr
+c    ........................................................
+c
+      EXTERNAL    filtreg
+      EXTERNAL  SCOPY, rotatf, nxgrad, laplacien_rotgam
+c
+c
+      signe    = (-1.)**lr
+      nugradrs = signe * crot
+c
+      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
+      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
+c
+      CALL rotatf     ( klevel, grx, gry, rot )
+c
+      CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
+
+c
+c    .....   Iteration de l'operateur laplacien_rotgam  .....
+c
+      DO  iter = 1, lr -2
+        CALL laplacien_rotgam ( klevel, rot, rot )
+      ENDDO
+c
+c
+      CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
+      CALL nxgrad ( klevel, rot, grx, gry )
+c
+      DO    l = 1, klevel
+         DO  ij = 1, ip1jm
+          gry( ij,l ) = gry( ij,l ) * nugradrs
+         ENDDO
+         DO  ij = 1, ip1jmp1
+          grx( ij,l ) = grx( ij,l ) * nugradrs
+         ENDDO
+      ENDDO
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrarot.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrarot.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/nxgrarot.F	(revision 46)
@@ -0,0 +1,54 @@
+      SUBROUTINE nxgrarot (klevel,xcov, ycov, lr, grx, gry )
+c   ***********************************************************
+c
+c    Auteur :  P.Le Van  
+c
+c                                 lr
+c      calcul de  ( nXgrad (rot) )   du vect. v  ....
+c
+c       xcov et ycov  etant les compos. covariantes de  v
+c   ***********************************************************
+c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
+c      grx   et  gry     sont des arguments de sortie pour le s-prog
+c
+c
+      IMPLICIT NONE
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissipn.h"
+#include "logic.h"
+c
+      INTEGER klevel
+      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
+      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
+c
+      REAL rot(ip1jm,llm)
+
+      INTEGER l,ij,iter,lr
+c
+      EXTERNAL    filtreg
+      EXTERNAL       SCOPY, rotat, nXgrad
+c
+c
+      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
+      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
+c
+      DO 10 iter = 1,lr
+      CALL rotat (klevel,grx, gry, rot )
+      CALL filtreg( rot, jjm, klevel, 2,1, .false.,2)
+      CALL nxgrad (klevel,rot, grx, gry )
+c
+      DO 5  l = 1, klevel
+      DO 2 ij = 1, ip1jm
+      gry( ij,l ) = - gry( ij,l ) * crot
+   2  CONTINUE
+      DO 3 ij = 1, ip1jmp1
+      grx( ij,l ) = - grx( ij,l ) * crot
+   3  CONTINUE
+   5  CONTINUE
+c
+  10  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/pression.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/pression.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/pression.F	(revision 46)
@@ -0,0 +1,29 @@
+      SUBROUTINE pression( ngrid, ap, bp, ps, p )
+c
+
+c      Auteurs : P. Le Van , Fr.Hourdin  .
+
+c  ************************************************************************
+c     Calcule la pression p(l) aux differents niveaux l = 1 ( niveau du
+c     sol) a l = llm +1, ces niveaux correspondant aux interfaces des (llm) 
+c     couches , avec  p(ij,llm +1) = 0.  et p(ij,1) = ps(ij)  .      
+c  ************************************************************************
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+c
+      INTEGER ngrid
+      INTEGER l,ij
+ 
+      REAL ap(llmp1), bp(llmp1), ps(ngrid), p(ngrid,llmp1) 
+      
+      DO    l    = 1, llmp1
+        DO  ij   = 1, ngrid
+         p(ij,l) = ap(l) + bp(l) * ps(ij)
+        ENDDO
+      ENDDO
+   
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/psextbar.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/psextbar.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/psextbar.F	(revision 46)
@@ -0,0 +1,105 @@
+      SUBROUTINE psextbar ( ps, psexbarxy )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c **********************************************************************
+c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
+c **********************************************************************
+c
+c         ps          est un  argum. d'entree  pour le s-pg ..
+c         psexbarxy   est un  argum. de sortie pour le s-pg ..
+c
+c   Methode:
+c   --------
+c
+c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
+c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
+c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
+c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
+c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
+c
+c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
+c
+c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
+c
+c
+c
+c   alpha4 .         . alpha1    . alpha4
+c    (i,j)             (i,j)       (i+1,j)
+c
+c             P .        U .          . P
+c           (i,j)       (i,j)         (i+1,j)
+c
+c   alpha3 .         . alpha2    .alpha3 
+c    (i,j)              (i,j)     (i+1,j)
+c
+c             V .        Z .          . V
+c           (i,j)
+c
+c   alpha4 .         . alpha1    .alpha4
+c   (i,j+1)            (i,j+1)   (i+1,j+1) 
+c
+c             P .        U .          . P
+c          (i,j+1)                    (i+1,j+1)
+c
+c
+c
+c
+c                       On  a :
+c
+c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
+c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
+c     localise  au point  ... U (i,j) ...
+c
+c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
+c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
+c     localise  au point  ... V (i,j) ...
+c
+c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
+c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
+c     localise  au point  ... Z (i,j) ...
+c
+c
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      REAL ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
+
+      INTEGER  l, ij
+      EXTERNAL SCOPY
+c
+
+      DO ij = 1, ip1jmp1
+       pext(ij) = ps(ij) * aire(ij)
+      ENDDO
+
+
+      DO     5     ij = 1, ip1jm - 1
+      psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
+     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
+   5  CONTINUE
+
+
+c    ....  correction pour     psexbarxy( iip1,j )  ........
+
+CDIR$ IVDEP
+
+      DO 7 ij = iip1, ip1jm, iip1
+      psexbarxy( ij ) = psexbarxy( ij - iim )
+   7  CONTINUE
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ran1.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ran1.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/ran1.F	(revision 46)
@@ -0,0 +1,31 @@
+      FUNCTION RAN1(IDUM)
+      DIMENSION R(97)
+      save r
+      save iff,ix1,ix2,ix3
+      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
+      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
+      PARAMETER (M3=243000,IA3=4561,IC3=51349)
+      DATA IFF /0/
+      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
+        IFF=1
+        IX1=MOD(IC1-IDUM,M1)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX2=MOD(IX1,M2)
+        IX1=MOD(IA1*IX1+IC1,M1)
+        IX3=MOD(IX1,M3)
+        DO 11 J=1,97
+          IX1=MOD(IA1*IX1+IC1,M1)
+          IX2=MOD(IA2*IX2+IC2,M2)
+          R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+11      CONTINUE
+        IDUM=1
+      ENDIF
+      IX1=MOD(IA1*IX1+IC1,M1)
+      IX2=MOD(IA2*IX2+IC2,M2)
+      IX3=MOD(IA3*IX3+IC3,M3)
+      J=1+(97*IX3)/M3
+      IF(J.GT.97.OR.J.LT.1)PAUSE
+      RAN1=R(J)
+      R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/readhead_NC.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/readhead_NC.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/readhead_NC.F	(revision 46)
@@ -0,0 +1,231 @@
+      SUBROUTINE readhead_NC (fichnom,
+     .           day0,
+     .           phis,constR)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+c====== includes de l ancien readhead ===
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "description.h"
+
+c======================================================================
+
+      CHARACTER*(*) fichnom
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+
+      INTEGER radpas
+
+      REAL xmin, xmax
+c
+      INTEGER  i
+
+c   Variables
+c
+      INTEGER length,iq
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid
+      CHARACTER  str3*3
+
+c
+      INTEGER day0
+      REAL phis(ip1jmp1),constR
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+
+
+c Info sur la Planete Mars pour la dynamique 
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+c      mugaz      = tab_cntrl(8)
+      cpp        =  744.499
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
+      preff=610.
+      WRITE (*,*) 'readhead -     preff ' , preff 
+c
+
+      day0=day_ini
+
+      constR=kappa*cpp
+      WRITE (*,*) 'constR = ' , constR
+      r=constR
+      IF(   im.ne.iim           )  THEN
+          PRINT 1,im,iim
+          STOP
+      ELSE  IF( jm.ne.jjm       )  THEN
+          PRINT 2,jm,jjm
+          STOP
+      ELSE  IF( lllm.ne.llm     )  THEN
+          PRINT 3,lllm,llm
+          STOP
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <aire> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(aire)
+      xmax = MAXVAL(aire)
+      PRINT*,'Aires des mailles <aire>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
+         CALL abort
+      ENDIF
+c      PRINT*,'READHEAD_NC  Phis:',phis
+
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <aps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <bps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
+         CALL abort
+      ENDIF
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur  dtinteg =',i4//)
+
+      
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE rotat (klevel, x, y, rot )
+c
+c     Auteur : P.Le Van 
+c**************************************************************
+c.  calcule le rotationnel
+c     a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
+      
+        DO l = 1, klevel
+          DO ij = 1, ip1jm
+           rot(ij,l) = rot(ij,l) * unsairez(ij)
+          ENDDO
+        ENDDO
+c
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat_nfil.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat_nfil.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotat_nfil.F	(revision 46)
@@ -0,0 +1,46 @@
+      SUBROUTINE rotat_nfil (klevel, x, y, rot )
+c
+c    Auteur :   P.Le Van 
+c**************************************************************
+c.          Calcule le rotationnel  non filtre   ,
+c      a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatf.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatf.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatf.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE rotatf (klevel, x, y, rot )
+c
+c     Auteur : P.Le Van 
+c**************************************************************
+c.  calcule le rotationnel
+c     a tous les niveaux d'1 vecteur de comp. x et y ..
+c       x  et  y etant des composantes  covariantes  ...
+c********************************************************************
+c   klevel, x  et y   sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+c
+c   .....  variables en arguments  ......
+c
+      INTEGER klevel
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+c
+c  ...   variables  locales  ...
+c
+      INTEGER  l, ij
+c
+c
+      DO  10 l = 1,klevel
+c
+        DO   ij = 1, ip1jm - 1
+         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
+     *                   x(ij +iip1, l )  -  x( ij,l )  
+        ENDDO
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+        DO  ij = iip1, ip1jm, iip1
+         rot( ij,l ) = rot( ij -iim,l )
+        ENDDO
+c
+  10  CONTINUE
+
+        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
+      
+        DO l = 1, klevel
+          DO ij = 1, ip1jm
+           rot(ij,l) = rot(ij,l) * unsairez(ij)
+          ENDDO
+        ENDDO
+c
+c
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatst.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatst.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/rotatst.F	(revision 46)
@@ -0,0 +1,40 @@
+      SUBROUTINE rotatst (klevel,x, y, rot )
+c
+c  P. Le Van
+c
+c    *****************************************************************
+c     .. calcule le rotationnel a tous les niveaux d'1 vecteur de comp. x et y ..
+c         x  et  y etant des composantes  covariantes  .....
+c    *****************************************************************
+c        x  et y     sont des arguments d'entree pour le s-prog
+c        rot          est  un argument  de sortie pour le s-prog
+c
+      IMPLICIT NONE
+c
+      INTEGER klevel
+#include "dimensions.h"
+#include "paramet.h"
+
+      REAL rot( ip1jm,klevel )
+      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
+      INTEGER  l, ij
+c
+c
+      DO 5 l = 1,klevel
+c
+      DO 1 ij = 1, ip1jm - 1
+      rot( ij,l )  =  (  y( ij+1 , l )  -  y( ij,l )   +
+     *                 x(ij +iip1, l )  -  x( ij,l )  )
+   1  CONTINUE
+c
+c    .... correction pour rot( iip1,j,l)  ....
+c
+c    ....   rot(iip1,j,l)= rot(1,j,l) ...
+CDIR$ IVDEP
+      DO 2 ij = iip1, ip1jm, iip1
+      rot( ij,l ) = rot( ij -iim,l )
+   2  CONTINUE
+c
+   5  CONTINUE
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/scal_wind.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/scal_wind.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/scal_wind.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE scal_wind(xus,xvs,xu,xv)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c On passe  les variable xus, xvs  aux points de vent u et v (xu et xv)
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL xu(iip1,jjp1,llm),xv(iip1,jjm,llm)
+      REAL xus(iip1,jjp1,llm), xvs (iip1,jjp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER i,j,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+        Do j=1,jjp1
+	      DO i=1,iim
+            xu(i,j,l)=0.5*(xus(i,j,l)+xus(i+1,j,l))
+	      ENDDO
+          xu(iip1,j,l)=xu(1,j,l)
+	    ENDDO
+      ENDDO
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO j=1,jjm
+           do i=1 ,iip1
+	         xv(i,j,l)=.5*(xvs(i,j,l)+xvs(i,j+1,l))
+           end do
+	     ENDDO
+	  ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc.F	(revision 46)
@@ -0,0 +1,164 @@
+      SUBROUTINE sortvarc
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:    P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   sortie des variables de controle
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "temps.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL vorpot(ip1jm,llm)
+      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
+      REAL dp(ip1jmp1)
+      REAL time
+      REAL pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
+      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
+      REAL cosphi(ip1jm),omegcosp(ip1jm)
+      REAL dtvrs1j,rjour,heure,radsg,radomeg
+      REAL rday, massebxy(ip1jm,llm)
+      INTEGER  l, ij, imjmp1
+
+      EXTERNAL  filtreg, massbarxy
+c     EXTERNAL FLUSH
+      EXTERNAL   SSUM, SCOPY 
+      REAL       SSUM
+
+c-----------------------------------------------------------------------
+
+       dtvrs1j   = dtvr/daysec
+       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       heure     = ( itau*dtvrs1j-rjour ) * 24.
+       imjmp1    = iim * jjp1
+       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
+c
+       CALL massbarxy ( masse, massebxy )
+
+c   .....  Calcul  de  rmsdpdt  .....
+
+       CALL multipl(ip1jmp1,dp,dp,ge)
+
+       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+c
+       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
+
+       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
+       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
+
+c   .....  Calcul du moment  angulaire   .....
+
+       radsg    = rad /g
+       radomeg  = rad * omeg
+c
+       DO ij=iip2,ip1jm
+          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
+          omegcosp(ij) = radomeg   * cosphi(ij)
+       ENDDO
+
+c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
+
+       DO l=1,llm
+          DO ij = 1,ip1jm
+             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
+          ENDDO
+          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
+
+          DO ij = 1,ip1jmp1
+             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
+     s        bernf(ij,l)-phi(ij,l))
+          ENDDO
+          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO   ij   = 1, ip1jmp1
+             ge(ij) = masse(ij,l)*teta(ij,l)
+          ENDDO
+          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO ij=1,ip1jmp1
+             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
+          ENDDO
+          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
+
+          DO ij =iip2,ip1jm
+             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
+     *               cosphi(ij)
+          ENDDO
+          angl(l) = radsg *
+     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
+      ENDDO
+
+          DO ij=1,ip1jmp1
+            ge(ij)= ps(ij)*aire(ij)
+          ENDDO
+      ptot  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
+      etot  = SSUM(     llm, etotl, 1 )
+      ztot  = SSUM(     llm, ztotl, 1 )
+      stot  = SSUM(     llm, stotl, 1 )
+      rmsv  = SSUM(     llm, rmsvl, 1 )
+      ang   = SSUM(     llm,  angl, 1 )
+
+      rday = FLOAT(INT ( day_ini + time ))
+c
+      IF(ptot0.eq.0.)  THEN
+         PRINT 3500, itau, rday, heure,time
+         PRINT*,'WARNING!!! On recalcule les valeurs initiales de :'
+         PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
+         PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+         etot0 = etot
+         ptot0 = ptot
+         ztot0 = ztot
+         stot0 = stot
+         ang0  = ang
+      END IF
+
+      etot= etot/etot0
+      rmsv= SQRT(rmsv/ptot)
+      ptot= ptot/ptot0
+      ztot= ztot/ztot0
+      stot= stot/stot0
+      ang = ang /ang0
+
+
+      PRINT 3500, itau, rday, heure, time
+      PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+
+      RETURN
+
+3500   FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x 
+     *   ,'date',f10.5,4x,10(1h*))
+4000   FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
+     * ,2x,'entropie',3x,'rmsv',4x,'mt.ang'/6x,f10.6,e13.6,5f10.3/
+     * )
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc0.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc0.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sortvarc0.F	(revision 46)
@@ -0,0 +1,141 @@
+      SUBROUTINE sortvarc0
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:    P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   sortie des variables de controle
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "temps.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL vorpot(ip1jm,llm)
+      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
+      REAL dp(ip1jmp1)
+      REAL time
+      REAL pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
+      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
+      REAL cosphi(ip1jm),omegcosp(ip1jm)
+      REAL dtvrs1j,rjour,heure,radsg,radomeg
+      REAL rday, massebxy(ip1jm,llm)
+      INTEGER  l, ij, imjmp1
+
+      EXTERNAL  filtreg, massbarxy
+c     EXTERNAL FLUSH
+      EXTERNAL   SSUM, SCOPY ,ismin,ismax
+      REAL       SSUM
+      integer  ismin,ismax
+
+c-----------------------------------------------------------------------
+
+       dtvrs1j   = dtvr/daysec
+       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       heure     = ( itau*dtvrs1j-rjour ) * 24.
+       imjmp1    = iim * jjp1
+       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
+c
+       CALL massbarxy ( masse, massebxy )
+
+c   .....  Calcul  de  rmsdpdt  .....
+
+       CALL multipl(ip1jmp1,dp,dp,ge)
+
+       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+c
+       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
+
+       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
+       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
+
+c   .....  Calcul du moment  angulaire   .....
+
+       radsg    = rad /g
+       radomeg  = rad * omeg
+c
+       DO ij=iip2,ip1jm
+          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
+          omegcosp(ij) = radomeg   * cosphi(ij)
+       ENDDO
+
+c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
+
+       DO l=1,llm
+          DO ij = 1,ip1jm
+             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
+          ENDDO
+          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
+
+          DO ij = 1,ip1jmp1
+             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
+     s        bernf(ij,l)-phi(ij,l))
+          ENDDO
+          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO   ij   = 1, ip1jmp1
+             ge(ij) = masse(ij,l)*teta(ij,l)
+          ENDDO
+          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO ij=1,ip1jmp1
+             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
+          ENDDO
+          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
+
+          DO ij =iip2,ip1jm
+             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
+     *               cosphi(ij)
+          ENDDO
+          angl(l) = radsg *
+     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
+      ENDDO
+
+          DO ij=1,ip1jmp1
+            ge(ij)= ps(ij)*aire(ij)
+          ENDDO
+      ptot0  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
+      etot0  = SSUM(     llm, etotl, 1 )
+      ztot0  = SSUM(     llm, ztotl, 1 )
+      stot0  = SSUM(     llm, stotl, 1 )
+      rmsv   = SSUM(     llm, rmsvl, 1 )
+      ang0   = SSUM(     llm,  angl, 1 )
+
+      rday = day_ini
+c
+      PRINT 3500, itau, rday, heure, time
+      PRINT *, ptot0,etot0,ztot0,stot0,ang0
+
+3500   FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x 
+     *   ,'date',f10.5,4x,10(1h*))
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/spline.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/spline.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/spline.F	(revision 46)
@@ -0,0 +1,76 @@
+      subroutine spline(x,y,n,yp1,ypn,y2)
+     
+c
+     
+c     Routine to set up the interpolating function for a cubic spline
+     
+c     interpolation (see "Numerical Recipes" for details).
+     
+c
+      implicit real (a-h,o-z)
+      implicit integer (i-n)
+     
+      parameter(nllm=4096)
+     
+      dimension x(n),y(n),y2(n),u(nllm)
+     
+c
+c	write(6,*)(x(i),i=1,n)
+c	write(6,*)(y(i),i=1,n)
+     
+      if(yp1.gt.0.99E30) then
+c the lower boundary condition is set
+       y2(1)=0.
+c either to be "natural"
+       u(1)=0.
+     
+      else
+c or else to have a specified first
+       y2(1)=-0.5
+c derivative
+       u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
+     
+      end if
+     
+      do 11 i=2,n-1
+c decomposition loop of the tridiagonal
+       sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
+c algorithm. Y2 and U are used
+       p=sig*y2(i-1)+2.
+c for temporary storage of the decompo-
+       y2(i)=(sig-1.)/p
+c sed factors
+       u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
+     
+     . /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
+     
+ 11   continue
+     
+      if(ypn.gt.0.99E30) then
+c the upper boundary condition is set
+       qn=0.
+c either to be "natural"
+       un=0.
+     
+      else
+c or else to have a specified first
+       qn=0.5
+c derivative
+       un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
+     
+      end if
+     
+      y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
+     
+      do 12 k=n-1,1,-1
+c this is the backsubstitution loop of
+       y2(k)=y2(k)*y2(k+1)+u(k)
+c the tridiagonal algorithm
+ 12   continue
+     
+c
+     
+      return
+     
+      end
+     
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/splint.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/splint.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/splint.F	(revision 46)
@@ -0,0 +1,53 @@
+     
+      SUBROUTINE splint(xa,ya,y2a,n,x,y)
+     
+c
+c     Routine to compute a cubic-spline interpolated value Y given the
+c     value of X, the arrays XA, YA and the 2nd derivative array Y2A
+c     computed by SUBROUTINE SPLINE. See "Numerical Recipes" for details
+c
+     
+      IMPLICIT REAL (a-h,o-z)
+      IMPLICIT INTEGER (i-n)
+      DIMENSION xa(n),ya(n),y2a(n)
+     
+      kl0=1
+     
+      khi=n
+c means of bisection
+ 1    IF(khi-kl0.gt.1) THEN
+     
+       k=(khi+kl0)/2
+     
+       IF(xa(k).gt.x) THEN
+     
+        khi=k
+     
+       ELSE
+     
+        kl0=k
+     
+       END IF
+     
+       GO TO 1
+     
+      END IF
+c KL0 and KHI now bracket the X
+      h=xa(khi)-xa(kl0)
+     
+      IF(h.eq.0.0) STOP
+      a=(xa(khi)-x)/h
+c evaluation of cubic spline polynomial
+      b=(x-xa(kl0))/h
+     
+      y=a*ya(kl0)+b*ya(khi)+((a**3-a)*y2a(kl0)+(b**3-b)*y2a(khi))*(h**2)
+     
+     ./6.
+     
+c
+     
+      RETURN
+     
+      END
+     
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sponge.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sponge.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/sponge.F	(revision 46)
@@ -0,0 +1,137 @@
+      subroutine sponge(ucov,vcov,h,pext,dt,mode)
+      implicit none
+#include "dimensions.h"
+#include "paramet.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "sponge.h"
+      real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)
+      real h(iip1,jjp1,llm),pext(iip1,jjp1)
+      real dt
+      real sig_s(llm) !sigma au milieu des couches
+      save sig_s
+
+c   Local:
+c   ------
+
+      REAL vm,um,hm,ptot(jjp1)
+      real cst(llm)
+      integer mode
+
+      INTEGER l,i,j,l0
+
+      real ssum
+
+      real echelle,zkm
+      logical firstcall
+      save firstcall,cst,l0
+      data firstcall/.true./
+
+      if (firstcall) then
+       do l=1,llm
+          sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+       enddo
+
+       IF (mode.eq.3) then
+         l0=llm-2
+         echelle=10.
+ 
+         PRINT*
+         print*,'sponge mode',mode
+         print*,'hsponge',hsponge
+         print*,'tetasponge n intervient pas'
+         print*,'Constantes de dissipations fixees comme les anglais'
+         print*,'Coeffs pour la couche en eponge'
+         print*,'Z (km)  tau'
+         cst(llm)=dt/(0.5*88775)
+         cst(llm-1)=dt/(88775)
+         cst(l0)=dt/(2*88775)
+         do l=l0,llm
+            zkm=-echelle*log(sig_s(l))
+            print*,zkm,dt/cst(l),cst(l)
+         enddo
+         firstcall=.false.
+         PRINT*
+       ELSE
+         l0=1
+         echelle=10.
+ 
+         PRINT*
+         print*,'sponge mode',mode
+         print*,'hsponge tetasponge ',hsponge,tetasponge
+         print*,'Coeffs pour la couche en eponge'
+         print*,'Z (km)  tau'
+         do l=1,llm
+            zkm=-echelle*log(sig_s(l))
+            cst(l)=.5*(1.+tanh((zkm-hsponge)/echelle))
+            cst(l)= max(tetasponge*1.e-15,cst(l))
+            print*,zkm,1./cst(l)*tetasponge,cst(l)*dt/tetasponge
+            cst(l)=cst(l)*dt/tetasponge
+         enddo
+         firstcall=.false.
+         PRINT*
+       ENDIF
+      endif
+
+c-----------------------------------------------------------------------
+c   calcul de la dissipation:
+c   -------------------------
+
+      do j=1,jjp1
+         ptot(j)=ssum(iim,pext(1,j),1)
+      enddo
+ 
+c   temperature potentielle
+      do l=l0,llm
+         do j=1,jjp1
+            hm=0.
+            do i=1,iim
+               hm=hm+h(i,j,l)*pext(i,j)
+            enddo
+            hm=hm/ptot(j)
+            do i=1,iim
+               h(i,j,l)=h(i,j,l)-cst(l)*(h(i,j,l)-hm)
+            enddo
+            h(iip1,j,l)=h(1,j,l)
+         enddo
+      enddo
+
+c   vent zonal
+      do l=l0,llm
+         do j=2,jjm
+            um=0.
+            if(mode.ge.1) then
+               do i=1,iim
+                  um=um+0.5*ucov(i,j,l)*(pext(i,j)+pext(i+1,j))
+     s               /cu(i,j)
+               enddo
+               um=um/ptot(j)
+            endif
+            do i=1,iim
+               ucov(i,j,l)=ucov(i,j,l)-cst(l)*(ucov(i,j,l)-um*cu(i,j))
+            enddo
+            ucov(iip1,j,l)=ucov(1,j,l)
+         enddo
+      enddo
+
+c  vent meridien
+      do l=l0,llm
+         do j=1,jjm
+            vm=0.
+            if(mode.ge.2) then
+               do i=1,iim
+                  vm=vm+vcov(i,j,l)*(pext(i,j)+pext(i,j+1))
+     s               /cv(i,j)
+               enddo
+               vm=vm/(ptot(j)+ptot(j+1))
+            endif
+            do i=1,iim
+               vcov(i,j,l)=vcov(i,j,l)-cst(l)*(vcov(i,j,l)-vm*cv(i,j))
+            enddo
+            vcov(iip1,j,l)=vcov(1,j,l)
+         enddo
+      enddo
+
+      RETURN
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/start2archive.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/start2archive.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/start2archive.F	(revision 46)
@@ -0,0 +1,389 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+
+#include "dimphys.h"
+#include "comsoil.h"
+#include"advtrac.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL q2(ngridmx,nlayermx+1),qsurf(ngridmx,nqmx)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      INTEGER*4 day_ini_fi
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1)
+      REAL tsoilS(ip1jmp1,nsoilmx)
+      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
+      REAL co2iceS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1),qsurfS(ip1jmp1,nqmx)
+      REAL emisS(ip1jmp1)
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+      integer :: nq,numvanle
+      character(len=30) :: txt ! to store some text
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      grireg   = .TRUE.
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+! Load tracer names:
+      call iniadvtrac(nq,numvanle)
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqmx,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,nqmx,day_ini_fi,timefi,
+     .      tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//fichnom
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.669)
+          day_ini=day_ini-669
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+c=======================================================================
+c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
+c=======================================================================
+c  Les variables modeles dependent de la resolution. Il faut donc
+c  eliminer les facteurs responsables de cette dependance
+c  (pour utiliser newstart)
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Vent   (depend de la resolution horizontale) 
+c-----------------------------------------------------------------------
+c
+c ucov --> un  et  vcov --> vn
+c un --> us  et   vn --> vs
+c
+c-----------------------------------------------------------------------
+
+      call covnat(llm,ucov, vcov, un, vn) 
+      call wind_scal(un,vn,us,vs) 
+
+c-----------------------------------------------------------------------
+c Temperature  (depend de la resolution verticale => de "sigma.def")
+c-----------------------------------------------------------------------
+c
+c h --> T
+c
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      ! Note: thermal inertia "inertiedat" is in comsoil.h
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqmx,ngridmx,iip1,jjp1,qsurf,qsurfS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+           co2icetotal = co2icetotal + 
+     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+c=======================================================================
+c Ecriture dans le fichier  "start_archive"
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Ouverture de "start_archive" 
+c-----------------------------------------------------------------------
+
+      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
+ 
+c-----------------------------------------------------------------------
+c  si "start_archive" n'existe pas:
+c    1_ ouverture
+c    2_ creation de l'entete dynamique ("ini_archive")
+c-----------------------------------------------------------------------
+c ini_archive:
+c On met dans l'entete le tab_cntrl dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+c-----------------------------------------------------------------------
+
+      if (ierr.ne.NF_NOERR) then
+         write(*,*)'OK, Could not open file "start_archive.nc"'
+         write(*,*)'So let s create a new "start_archive"'
+         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
+         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqmx] )
+c-----------------------------------------------------------------------
+      do iq=1,nqmx
+c       write(str2,'(i2.2)') iq
+c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
+c     .         3,q(1,1,iq))
+        call write_archive(nid,ntime,tnom(iq),'tracer','kg/kg',
+     &         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqmx] )
+c-----------------------------------------------------------------------
+      do iq=1,nqmx
+c       write(str2,'(i2.2)') iq
+c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
+c     $  'kg.m-2',2,qsurfS(1,iq))
+        txt=trim(tnom(iq))//"_surf"
+        call write_archive(nid,ntime,txt,'Tracer on surface',
+     &  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+c      do isoil=1,nsoilmx
+c       write(str2,'(i2.2)') isoil
+c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+c     .   'K',2,tsoilS(1,isoil))
+c      enddo
+
+! Write soil temperatures tsoil
+      call write_archive(nid,ntime,'tsoil','Soil temperature',
+     &     'K',-3,tsoilS)
+
+! Write soil thermal inertia
+      call write_archive(nid,ntime,'inertiedat',
+     &     'Soil thermal inertia',
+     &     'J.s-1/2.m-2.K-1',-3,ithS)
+
+! Write (0D) volumetric heat capacity (stored in comsoil.h)
+!      call write_archive(nid,ntime,'volcapa',
+!     &     'Soil volumetric heat capacity',
+!     &     'J.m-3.K-1',0,volcapa)
+! Note: no need to write volcapa, it is stored in "controle" table
+
+      ierr=NF_CLOSE(nid)
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+
+      end 
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/test_period.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/test_period.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/test_period.F	(revision 46)
@@ -0,0 +1,86 @@
+      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
+c
+c     Auteur : P. Le Van  
+c    ---------
+c  ....  Cette routine teste la periodicite en longitude des champs   ucov,
+c                           teta, q , p et phis                 .......... 
+c
+c     IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+c
+c    ......  Arguments   ......
+c
+      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
+     ,      q(ip1jmp1,llm,nqmx), p(ip1jmp1,llmp1), phis(ip1jmp1)
+c
+c   .....  Variables  locales  .....
+c
+      INTEGER ij,l,nq
+c
+      DO l = 1, llm
+         DO ij = 1, ip1jmp1, iip1
+          IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas',  
+     ,  ' periodique en longitude ! '
+          PRINT *,' l,  ij = ', l, ij, ij+iim
+          STOP
+          ENDIF
+          IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas',  
+     ,   ' periodique en longitude ! '
+          PRINT *,' l,  ij = ', l, ij, ij+iim
+          STOP
+          ENDIF
+         ENDDO
+      ENDDO
+
+c
+      DO l = 1, llm
+         DO ij = 1, ip1jm, iip1
+          IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas',  
+     ,   ' periodique en longitude !'
+          PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
+          vcov(ij+iim,l)=vcov(ij,l)
+          STOP
+          ENDIF
+         ENDDO
+      ENDDO
+      
+c
+      DO nq =1, nqmx
+        DO l =1, llm
+          DO ij = 1, ip1jmp1, iip1
+          IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
+          PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ',  
+     ,   'periodique en longitude !'
+          PRINT *,' nq , l,  ij, ij+iim = ', nq, l, ij, ij+iim
+        PRINT *,'q(ij,l,nq) q(ij+iim,l,nq) ',q(ij,l,nq),q(ij+iim,l,nq)
+          STOP
+          ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+c
+       DO l = 1, llm
+         DO ij = 1, ip1jmp1, iip1
+          IF( p(ij,l).NE.p(ij+iim,l) )  THEN
+          PRINT *,'STOP dans test_period car ---  P  ---  n est pas',  
+     ,    ' periodique en longitude !'
+          PRINT *,' l ij = ',l, ij, ij+iim
+          STOP
+          ENDIF
+          IF( phis(ij).NE.phis(ij+iim) )  THEN
+          PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas',  
+     ,   ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
+          PRINT *,' ij = ', ij, ij+iim
+          STOP
+          ENDIF
+         ENDDO
+       ENDDO
+c
+c
+         RETURN
+         END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/testharm.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/testharm.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/testharm.F	(revision 46)
@@ -0,0 +1,44 @@
+      PROGRAM testharm
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      integer i,j,ii,jj
+      real pi
+      real psi(jjp1,jjp1,iim) , fphi(iim,iim)
+      character file*20, str2*2, str2b*2
+
+#include "serre.h"
+#include "fxyprim.h"
+
+      pi=2.*asin(1.)
+
+      call harmspher( fphi,psi )
+      print*,'FIN de harmspher'
+
+      do i=1,iim
+         write(str2,'(i2.2)') i
+         file='Phi'//str2
+         open(10,file=file,form='formatted')
+         print*,'i,file',i,file
+         do ii=1,iim
+            write(10,*) fx(float(ii))*180./pi,fphi(ii,i)
+         enddo
+         close(10)
+      enddo
+
+      do i=1,iim
+         do j=1,jjp1
+            write(str2,'(i2.2)') i
+            write(str2b,'(i2.2)') j
+            file='Psi.'//str2//'.'//str2b
+            open(10,file=file,form='formatted')
+            do jj=1,jjp1
+               write(10,*) fy(float(jj))*180./pi,psi(jj,j,i)
+            enddo
+            close(10)
+         enddo
+      enddo
+
+      end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tourpot.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tourpot.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tourpot.F	(revision 46)
@@ -0,0 +1,79 @@
+      SUBROUTINE tourpot ( vcov, ucov, massebxy, vorpot )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c    .........      calcul du tourbillon potentiel             .........
+c    *******************************************************************
+c
+c     vcov,ucov,fext et pbarxyfl sont des argum. d'entree pour le s-pg .
+c             vorpot            est  un argum.de sortie pour le s-pg .
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "logic.h"
+
+      REAL  rot( ip1jm,llm )
+      REAL vcov( ip1jm,llm ),ucov( ip1jmp1,llm )
+      REAL massebxy( ip1jm,llm ),vorpot( ip1jm,llm )
+
+      INTEGER l, ij
+
+      EXTERNAL filtreg
+
+
+
+c  ... vorpot = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) /psbarxy ..
+
+
+
+c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
+
+      DO 5 l = 1,llm
+
+      DO 2 ij = 1, ip1jm - 1
+      rot( ij,l ) = vcov(ij+1,l)-vcov(ij,l)+ucov(ij+iip1,l)-ucov(ij,l)
+   2  CONTINUE
+
+c    ....  correction pour  rot( iip1,j,l )  .....
+c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
+
+CDIR$ IVDEP
+
+      DO 3 ij = iip1, ip1jm, iip1
+      rot( ij,l ) = rot( ij -iim, l )
+   3  CONTINUE
+
+   5  CONTINUE
+
+
+      CALL filtreg( rot, jjm, llm, 2, 1, .FALSE., 1 )
+
+
+      DO 10 l = 1, llm
+
+      DO 6 ij = 1, ip1jm - 1
+      vorpot( ij,l ) = ( rot(ij,l) + fext(ij) ) / massebxy(ij,l)
+   6  CONTINUE
+
+c    ..... correction pour  vorpot( iip1,j,l)  .....
+c    ....   vorpot(iip1,j,l)= vorpot(1,j,l) ....
+CDIR$ IVDEP
+      DO 8 ij = iip1, ip1jm, iip1
+      vorpot( ij,l ) = vorpot( ij -iim,l )
+   8  CONTINUE
+
+  10  CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/traceur.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/traceur.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/traceur.F	(revision 46)
@@ -0,0 +1,81 @@
+      SUBROUTINE traceur (iq,iadv,q,teta,pk,w, pbaru, pbarv,dq )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  F.Forget / A.Armengaud
+c   -------
+c
+c   ....  Modif  P.Le Van  ,  29/04/97  et 01/06/98    ....
+c
+c   ********************************************************************
+c   Transport des traceurs (dont l'humidite q(1)) par differents shemas
+c   ********************************************************************
+c     iq,q,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c     iadv = 1 :  Schema de transport type "humidite specifique  LMD"
+c                 (shema amont (horiz),moy arithmetique (vertic))
+c
+c     iadv = 2  :  Shema amont
+c
+c
+c     iadv = 0  : Indice montrant que q n'est pas vraiment un 
+c                traceur, mais une variable pronostique attachee
+c                (par exemple : une pente du shemas de pente)
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+c   Arguments:
+c   ----------
+      INTEGER iq,iadv(iq) 
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q( ip1jmp1,llm,iq), dq( ip1jmp1,llm,iq)
+      REAL w(ip1jmp1,llm),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      LOGICAL     qsat
+      PARAMETER ( qsat = .TRUE. )
+
+c
+cc ******     Si  iadv(iq) =  2   et   qsat = .TRUE.  ,   
+cc        ,  on choisit  le shema  amont avec le q sature   ********
+c
+
+      EXTERNAL adv_h2o, amont, amont_qsat
+
+
+       IF( iadv(iq).GT.2 )  THEN
+         PRINT *,' Erreur dans le choix de iadv  pour la routine 
+     *  traceur .  Corrigez . '
+         STOP
+       ENDIF
+
+c   ----------------------------------------------------------------
+c   Schema de transport type "humidite specifique  LMD" 
+c   (shema amont (horiz),moy arithmetique (vertic))
+c   ----------------------------------------------------------------
+         IF (iadv(iq).EQ.1) THEN
+              CALL adv_h2o (iq,iq,q,w, pbaru, pbarv,dq)       
+c   ----------------------------------------------------------------
+c   Shema amont (dans les 3 dimensions)
+c   ----------------------------------------------------------------
+         ELSE IF (iadv(iq).EQ.2) THEN
+           IF( qsat )   THEN
+              CALL amont_qsat ( iq,iq,q,teta,pk,w, pbaru, pbarv,dq )
+           ELSE
+              CALL amont      ( iq,iq,q,        w, pbaru, pbarv,dq )
+           ENDIF
+c   ----------------------------------------------------------------
+
+         ENDIF
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tracvl.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tracvl.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/tracvl.F	(revision 46)
@@ -0,0 +1,127 @@
+      SUBROUTINE tracvl(numvanle,iapp_tracvl,nq,pbaru,pbarv ,
+     *                    p, masse , q, iapptrac, iadv1, teta, pk  )
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c                 F. Codron     (10/99)
+
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+
+c     .... Arguments  ....
+c
+      INTEGER numvanle, nq, iapp_tracvl, iapptrac, iadv1
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
+      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
+      REAL pk(ip1jmp1,llm)
+
+c     ....  var. locales  .....
+c
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
+
+
+      INTEGER iadvtr, numvan
+      INTEGER ij,l,iq
+      REAL zdpmin, zdpmax
+      EXTERNAL  minmax
+      SAVE iadvtr, massem, pbaruc, pbarvc, numvan
+      DATA iadvtr/0/
+
+      numvan = numvanle
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
+c
+      ENDIF
+
+      iadvtr   = iadvtr+1
+      iapptrac = iadvtr
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.iapp_tracvl ) THEN
+
+cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
+cc
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+
+c  test sur l'eventuelle creation de valeurs negatives de la masse
+         DO l=1,llm-1
+            DO ij = iip2+1,ip1jm
+              zdp(ij) = pbarug(ij-1,l) - pbarug(ij,l)
+     s                  - pbarvg(ij-iip1,l) + pbarvg(ij,l)
+     s                  + wg(ij,l+1) - wg(ij,l)
+            ENDDO
+            CALL SCOPY( jjm -1 ,zdp(iip1+iip1),iip1,zdp(iip2),iip1 )
+            DO ij = iip2,ip1jm
+               zdp(ij)= zdp(ij)*dtvr/ massem(ij,l) 
+            ENDDO 
+
+
+            CALL minmax ( ip1jm-iip1, zdp(iip2), zdpmin,zdpmax )
+
+            IF(MAX(ABS(zdpmin),ABS(zdpmax)).GT.0.5) THEN
+            PRINT*,'WARNING DP/P l=',l,'  MIN:',zdpmin,
+     s        '   MAX:', zdpmax
+            ENDIF
+
+         ENDDO
+
+c   Advection proprement dite.
+c
+c   test sur iadv1 pour le schema de vapeur d'eau
+c
+         IF (numvanle.EQ.1.AND.iadv1.EQ.4) THEN
+           CALL vlspltqs( q(1,1,1), 2., massem, wg ,
+     *                 pbarug,pbarvg,dtvr,p,pk,teta )
+           numvan = 2
+         ENDIF
+
+         DO iq = numvan, nq
+          CALL vlsplt( q(1,1,iq), 2. ,massem,wg,pbarug,pbarvg,dtvr )
+         ENDDO
+         iadvtr=0
+
+c   on reinitialise a zero les flux de masse cumules.
+
+      ENDIF ! if iadvtr.EQ.iapp_tracvl
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vanleer.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vanleer.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vanleer.F	(revision 46)
@@ -0,0 +1,71 @@
+      SUBROUTINE vanleer(numvanle,iapp_tracvl,nq,q,pbaru,pbarv ,
+     *                     p ,masse, dq ,  iadv1, teta, pk      )
+c
+      IMPLICIT NONE
+c
+c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron  
+c
+c=======================================================================
+c
+c       Shema de  Van Leer
+c       Version simplifiée pour Mars
+c       (L'original bugue a cause des histoires d'eau terrestre !!)
+c       FF 2003
+c
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+
+c   Arguments:
+c   ----------
+      INTEGER nq, numvanle, iapp_tracvl, iadv1 
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
+      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nq),dq( ip1jmp1,llm,nq )
+      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
+c  ..................................................................
+c
+c   Local:
+c   ------
+
+!      EXTERNAL  tracvl,minmaxq, qminimum
+      INTEGER ij,l, iq, iapptrac
+      REAL finmasse(ip1jmp1,llm), dtvrtrac
+cc
+
+        CALL SCOPY( nq * ijp1llm, q, 1, dq, 1 )
+
+c   advection
+
+      CALL tracvl( numvanle,iapp_tracvl,nq,pbaru,pbarv,p , masse,q  ,
+     *                      iapptrac, iadv1, teta ,pk              )
+
+cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
+c
+          DO l = 1, llm
+           DO ij = 1, ip1jmp1
+             finmasse(ij,l) =  p(ij,l) - p(ij,l+1) 
+           ENDDO
+          ENDDO
+
+          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
+          CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
+c
+c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
+
+          dtvrtrac = iapp_tracvl * dtvr
+c
+           DO iq = 1 , nq ! modif special mars : 2 devient nq
+            DO l = 1 , llm
+             DO ij = 1,ip1jmp1
+             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
+     *                               /  dtvrtrac
+             ENDDO
+            ENDDO
+           ENDDO
+
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vitvert.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vitvert.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vitvert.F	(revision 46)
@@ -0,0 +1,49 @@
+      SUBROUTINE vitvert ( convm , w )
+c
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:  P. Le Van , F. Hourdin .
+c   -------
+c
+c   Objet:
+c   ------
+c
+c    *******************************************************************
+c  .... calcul de la vitesse verticale aux niveaux sigma  ....
+c    *******************************************************************
+c     convm   est un argument  d'entree pour le s-pg  ......
+c       w     est un argument de sortie pour le s-pg  ......
+c
+c    la vitesse verticale est orientee de  haut en bas .
+c    au sol, au niveau sigma(1),   w(i,j,1) = 0.
+c    au sommet, au niveau sigma(llm+1) , la vit.verticale est aussi
+c    egale a 0. et n'est pas stockee dans le tableau w  .
+c
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+
+      REAL w(ip1jmp1,llm),convm(ip1jmp1,llm)
+      INTEGER   l, ij
+
+
+
+      DO 2  l = 1,llmm1
+
+      DO 1 ij = 1,ip1jmp1
+      w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 )
+   1  CONTINUE
+
+   2  CONTINUE
+
+      DO 5 ij  = 1,ip1jmp1
+      w(ij,1)  = 0.
+5     CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlsplt.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlsplt.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlsplt.F	(revision 46)
@@ -0,0 +1,887 @@
+      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c   pente_max facteur de limitation des pentes: 2 en general
+c                                               0 pour un schema amont
+c   pbaru,pbarv,w flux de masse en u ,v ,w
+c   pdt pas de temps
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l
+c
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c      PRINT*,'Debut vlsplt version debug sans vly'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlx     ')
+      call vlx(zq,pente_max,zm,mu)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vly     ')
+
+      call vly(zq,pente_max,zm,mv)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vly     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vly     ')
+
+      call vly(zq,pente_max,zm,mv)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlx     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlx     ')
+
+      call vlx(zq,pente_max,zm,mu)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlx     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlx(q,pente_max,masse,u_m)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps1,temps2,temps3,temps4,temps5
+      SAVE temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tENDances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   ModIF Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vly(q,pente_max,masse,masse_adv_v)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c     SPECIAL MARS :  on ajoute un test ("max") pour eviter les division
+c     par des "dyq" trop faible (special compilateur SUN) 27/11/2003 F. Forget
+
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/ max(abs(dyq(ij,l)),1.E-30),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs= min(pente_max*adyqv(ij+ip1jm-iip1) 
+     &              / max(abs(dyq(ij+ip1jm,l)),1.E-30) ,fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+          IF(masse_adv_v(ij,l).gt.0) THEN
+              qbyv(ij,l)=q(ij+iip1,l)+dyq(ij+iip1,l)*
+     ,                   0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l))
+          ELSE
+              qbyv(ij,l)=q(ij,l)-dyq(ij,l)*
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l))
+          ENDIF
+          qbyv(ij,l)=masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlz(q,pente_max,masse,w)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c    q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c     dq 	       sont des arguments de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL wq(ip1jmp1,llm+1),newmasse
+
+      REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax
+      REAL sigw
+
+      LOGICAL testcpu
+      SAVE testcpu
+
+      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      REAL      SSUM
+      EXTERNAL  SSUM, convflu
+      EXTERNAL filtreg
+
+      DATA testcpu/.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+#ifdef BIDON
+      IF(testcpu) THEN
+         temps0=second(0.)
+      ENDIF
+#endif
+      DO l=2,llm
+         DO ij=1,ip1jmp1
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         ENDDO
+      ENDDO
+
+      DO l=2,llm-1
+         DO ij=1,ip1jmp1
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            ELSE
+                dzq(ij,l)=0.
+            ENDIF
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      ENDDO
+
+#ifdef BIDON
+      IF(testcpu) THEN
+         temps1=temps1+second(0.)-temps0
+      ENDIF
+#endif
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+
+       DO l = 1,llm-1
+         do  ij = 1,ip1jmp1
+          IF(w(ij,l+1).gt.0.) THEN
+             sigw=w(ij,l+1)/masse(ij,l+1)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1)+0.5*(1.-sigw)*dzq(ij,l+1))
+          ELSE
+             sigw=w(ij,l+1)/masse(ij,l)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+          ENDIF
+         ENDDO
+       ENDDO
+
+       DO ij=1,ip1jmp1
+          wq(ij,llm+1)=0.
+          wq(ij,1)=0.
+       ENDDO
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+      ENDDO
+
+
+      RETURN
+      END
+      SUBROUTINE minmaxq(zq,qmin,qmax,comment)
+
+#include "dimensions.h"
+#include "paramet.h"
+
+      CHARACTER*(*) comment
+      real qmin,qmax
+      real zq(ip1jmp1,llm)
+
+      INTEGER jadrs(ip1jmp1), jbad, k, i
+
+      DO k = 1, llm
+         jbad = 0
+         DO i = 1, ip1jmp1
+         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
+            jbad = jbad + 1
+            jadrs(jbad) = i
+         ENDIF
+         ENDDO
+         IF (jbad.GT.0) THEN
+         PRINT*, comment
+         DO i = 1, jbad
+cc            PRINT*, "i,k,zq=", jadrs(i),k,zq(jadrs(i),k)
+         ENDDO
+         ENDIF
+      ENDDO
+
+      return
+      end
+
+
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlspltqs.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlspltqs.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/vlspltqs.F	(revision 46)
@@ -0,0 +1,775 @@
+       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
+     ,                                  p,pk,teta                 )
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
+c
+c    ********************************************************************
+c          Shema  d'advection " pseudo amont " .
+c      + test sur humidite specifique: Q advecte< Qsat aval
+c                   (F. Codron, 10/99)
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c     pente_max facteur de limitation des pentes: 2 en general
+c                                                0 pour un schema amont
+c     pbaru,pbarv,w flux de masse en u ,v ,w
+c     pdt pas de temps
+c
+c     teta temperature potentielle, p pression aux interfaces,
+c     pk exner au milieu des couches necessaire pour calculer Qsat
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL qsat(ip1jmp1,llm)
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c--pour rapport de melange saturant--
+
+      REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL tempe(ip1jmp1)
+
+c    fonction psat(T)
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+
+c-- Calcul de Qsat en chaque point
+c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
+c   pour eviter une exponentielle.
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   = 0.5*(p(ij,l)+p(ij,l+1))
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+
+c      PRINT*,'Debut vlsplt version debug sans vlyqs'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlxqs     ')
+
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlxqs     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+c--pas encore modification sur Qsat
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+c   le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind)
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c   pas d'influence de la pression saturante (pour l'instant)
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tendances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     qsat 	       est   un argument de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+         IF( masse_adv_v(ij,l).GT.0. ) THEN
+           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l )  +
+     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l)))
+         ELSE
+              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l) - dyq(ij,l) *
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l)) )
+         ENDIF
+          qbyv(ij,l) = masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps  = -SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wind_scal.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wind_scal.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wind_scal.F	(revision 46)
@@ -0,0 +1,55 @@
+      SUBROUTINE wind_scal(pbaru,pbarv,us,vs)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c   On ramene les flux de masse /vents  aux points scalaires.
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL us(ip1jmp1,llm), vs (ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER ij,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+	 DO ij=2,ip1jmp1
+            us(ij,l)=.5*(pbaru(ij,l)+pbaru(ij-1,l))
+	 ENDDO
+      ENDDO
+      CALL SCOPY(jjp1*llm,us(iip1,1),iip1,us(1,1),iip1)
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+	    vs(ij,l)=.5*(pbarv(ij,l)+pbarv(ij-iip1,l))
+	 ENDDO
+	 DO ij=1,iip1
+	    vs(ij,l)=0.
+	    vs(ip1jm+ij,l)=0.
+	 ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wrgrads.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wrgrads.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/wrgrads.F	(revision 46)
@@ -0,0 +1,125 @@
+      subroutine wrgrads(if,nl,field,name,titlevar)
+      implicit none
+
+c   Declarations
+c    if indice du fichier
+c    nl nombre de couches
+c    field   champ
+c    name    petit nom
+c    titlevar   Titre
+
+#include "gradsdef.h"
+
+c   arguments
+      integer if,nl
+      real field(imx*jmx*lmx)
+      character*10 name,file
+      character*10 titlevar
+
+c   local
+
+      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
+
+      logical writectl
+
+
+      writectl=.false.
+
+c     print*,if,iid(if),jid(if),ifd(if),jfd(if)
+      iii=iid(if)
+      iji=jid(if)
+      iif=ifd(if)
+      ijf=jfd(if)
+      im=iif-iii+1
+      jm=ijf-iji+1
+      lm=lmd(if)
+
+c      print*,'im,jm,lm,name,firsttime(if)'
+c      print*,im,jm,lm,name,firsttime(if)
+
+      if(firsttime(if)) then
+         if(name.eq.var(1,if)) then
+            firsttime(if)=.false.
+            ivar(if)=1
+         print*,'fin de l initialiation de l ecriture du fichier'
+         print*,file
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+         else
+            ivar(if)=ivar(if)+1
+            nvar(if)=ivar(if)
+            var(ivar(if),if)=name
+            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
+            nld(ivar(if),if)=nl
+            print*,'initialisation ecriture de ',var(ivar(if),if)
+            print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
+         endif
+         writectl=.true.
+         itime(if)=1
+      else
+         ivar(if)=mod(ivar(if),nvar(if))+1
+         if (ivar(if).eq.nvar(if)) then
+            writectl=.true.
+            itime(if)=itime(if)+1
+         endif
+
+         if(var(ivar(if),if).ne.name) then
+           print*,'Il faut stoker la meme succession de champs a chaque'
+           print*,'pas de temps'
+           print*,'fichier no: ',if
+           print*,'unit ',unit(if)
+           print*,'nvar  ',nvar(if)
+           print*,'vars ',(var(iv,if),iv=1,nvar(if))
+
+           stop
+         endif
+      endif
+
+c     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
+c     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
+      do l=1,nl
+         irec(if)=irec(if)+1
+c        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
+c    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
+c    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
+         write(unit(if)+1,rec=irec(if))
+     s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
+     s   ,i=iii,iif),j=iji,ijf)
+      enddo
+      if (writectl) then
+
+      file=fichier(if)
+c   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      open(unit(if),file=file(1:lnblnk(file))//'.ctl',
+     &         form='formatted',status='unknown')
+      write(unit(if),'(a5,1x,a40)')
+     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
+
+      write(unit(if),'(a12)') 'UNDEF 1.0E30'
+      write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
+      call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
+      call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
+      call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
+      write(unit(if),'(a4,i10,a30)')
+     &       'TDEF ',itime(if),' LINEAR 02JAN1987 1MO '
+      write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
+      do iv=1,nvar(if)
+c        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
+c        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
+         write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
+     &     ,99,tvar(iv,if)
+      enddo
+      write(unit(if),'(a7)') 'ENDVARS'
+c
+1000  format(a5,3x,i4,i3,1x,a39)
+
+      close(unit(if))
+
+      endif ! writectl
+
+      return
+
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/write_archive.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/write_archive.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/write_archive.F	(revision 46)
@@ -0,0 +1,252 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
+c   -----    dans un fichier DRS nomme "start_archive"
+c
+c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
+c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
+c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
+c    (ex: la longitude solaire)
+c
+c
+c   Arguments: 
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c		  nid      Unite logique du fichier "start_archive"
+c         nom      nom du champ a ecrire dans le fichier "start_archive"
+c         titre    titre de la variable dans le fichier DRS "start_archive"
+c         unite    unite de la variable ....
+c         dim      dimension de la variable a ecrire
+c         px       tableau contenant la variable a ecrire
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid
+      integer ntime ! time index
+      integer dim 
+      REAL px(iip1,jjp1,llm) 
+
+      CHARACTER*(*) nom, titre, unite
+
+      integer ierr
+
+
+c local
+      integer, dimension(4) :: edges,corner,id
+      integer :: varid,i,j,l
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+! For an atmospheric 3D Variable
+!--------------------------------
+        if (dim.eq.3) then
+
+!         Ecriture du champs
+
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+! For a subterranean 3D Variable
+!-------------------------------
+
+        else if (dim.eq.-3) then
+	! get variables' ID, if it exists
+	ierr=NF_INQ_VARID(nid,nom,varid)
+	
+	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
+	  ! build related coordinates
+	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
+	  if (ierr.ne.NF_NOERR) then
+	   write(*,*)"write_archive: dimension <subsurface_layers>",
+     &               " is missing !!!"
+	   call abort
+	  endif
+          ierr=NF_INQ_DIMID(nid,"Time",id(4))
+	  
+	  ! define the variable
+	  write(*,*)"====================="
+	  write(*,*)"defining ",nom
+	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+	  
+	 endif
+
+        ! build cedges and corners
+        corner(1)=1
+        corner(2)=1
+        corner(3)=1
+        corner(4)=ntime
+
+        edges(1)=iip1
+        edges(2)=jjp1
+        edges(3)=nsoilmx
+        edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+
+! For a surface 2D Variable
+!--------------------------
+
+        else if (dim.eq.2) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+        else
+	  write(*,*) "write_archive: dim=",dim," ?!?"
+	  call abort
+        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
+
+      return
+      end
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/xvik.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/xvik.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/dyn3d/xvik.F	(revision 46)
@@ -0,0 +1,546 @@
+      PROGRAM xvik
+      IMPLICIT NONE
+c=======================================================================
+c
+c  Pression au site Viking
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"      
+
+
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,jj
+      REAL constR
+
+c   Declarations NCDF:
+c   -----------------
+      CHARACTER*100  varname
+      INTEGER ierr,nid,nvarid,dimid
+      LOGICAL nc
+      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
+      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
+
+c   declarations pour les points viking:
+c   ------------------------------------
+      INTEGER ivik(2),jvik(2),ifile(2),iv
+      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
+      REAL unanj
+
+c   variables meteo:
+c   ----------------
+      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
+      REAL co2ice(iip1,jjp1), captotN,captotS
+      real t7(iip1,jjp1) ! temperature in 7th atmospheric layer
+
+      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
+
+      LOGICAL firstcal,lcal,latcal,lvent,day_ls
+      INTEGER*4 day0
+
+      REAL ziceco2(iip1,jjp1)
+      REAL day,zt,sollong,sol,dayw
+      REAL airtot1,gh
+
+      INTEGER ii,iyear,kyear
+
+      CHARACTER*2 chr2
+
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER pathchmp*80,pathsor*80,nomfich*80
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL inifilr,exner,pbar
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unanj=667.9
+      print*,'WARNING!!!',unanj,'Jours/an'
+      nc=.true.
+      lcal=.true.
+      latcal=.true.
+      lvent=.false.
+      day_ls=.true.
+
+c lecture du fichier xvik.def
+
+      phivik(1)=-3627
+      phivik(2)=-4505
+
+
+
+      OPEN(99,file='xvik.def',form='formatted')
+
+      READ(99,*) 
+      READ(99,*,iostat=ierr) phivik
+      IF(ierr.NE.0) GOTO 105
+
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathchmp
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathsor
+      READ(99,*,END=105)
+c     READ(99,'(l1)',END=105) day_ls
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lcal
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lvent
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) latcal
+ 
+ 105  CONTINUE
+      CLOSE(99)
+      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
+      DO iv=1,2
+         phivik(iv)=phivik(iv)*3.73
+      END DO
+
+      write(*,*) ' pathchmp:',trim(pathchmp)
+      write(*,*) ' pathsor:',trim(pathsor)
+      
+c-----------------------------------------------------------------------
+c-----------------------------------------------------------------------
+c   ouverture des fichiers xgraph:
+c   ------------------------------
+
+      ifile(1)=12
+      ifile(2)=13
+      kyear=-1
+c      OPEN(77,file='xlongday',form='formatted')
+
+      unitlec=11
+c
+      PRINT*,'entrer le nom du fichier NC'
+      READ(5,'(a)') nomfich
+
+      PRINT *,'nomfich : ',nomfich
+
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   grande boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      firstcal=.true.
+      DO WHILE(lnblnk(nomfich).GT.0.AND.lnblnk(nomfich).LT.50)
+      PRINT *,'>>>  nomfich : ',trim(nomfich)
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      file=pathchmp(1:lnblnk(pathchmp))//'/'//
+     s     nomfich(1:lnblnk(nomfich))
+      PRINT*,'file.nc: ', file(1:lnblnk(file))//'.nc'
+      PRINT*,'timestep ',dtvr
+
+      IF(nc) THEN
+      ierr= NF_OPEN(file(1:lnblnk(file))//'.nc',NF_NOWRITE,nid)        
+      ELSE
+         PRINT*,'Ouverture binaire ',file
+         OPEN(unitlec,file=file,status='old',form='unformatted',
+     .   iostat=ierr)
+      ENDIF
+
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+      CALL readhead_NC(file(1:lnblnk(file))//'.nc',day0,phis,constR)
+
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+
+c   Lecture temps :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+
+        PRINT*,'temps',(temps(itau),itau=1,10)
+              
+c-----------------------------------------------------------------------
+c   coordonnees des point Viking:
+c   -----------------------------
+
+      latvik(1)=22.27*pi/180.
+      lonvik(1)=-47.9*pi/180.
+      latvik(2)=47.67*pi/180.
+      lonvik(2)=(360.-225.71)*pi/180.
+
+c   ponderations pour les 4 points autour de Viking
+      DO iv=1,2
+         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
+         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
+            ivik(iv)=ivik(iv)-1
+         ENDIF
+         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
+            jvik(iv)=jvik(iv)-1
+         ENDIF
+         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
+     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
+         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
+     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
+         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
+         zw(1,0,iv)=zalpha*(1.-zbeta)
+         zw(0,1,iv)=(1.-zalpha)*zbeta
+         zw(1,1,iv)=zalpha*zbeta
+      ENDDO
+
+c   altitude reelle et modele aux points Viking
+      DO iv=1,2
+         phisim(iv)=0.
+         DO jj=0,1
+            j=jvik(iv)+jj
+            DO ii=0,1
+               i=ivik(iv)+ii
+               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
+            ENDDO
+         ENDDO
+      ENDDO
+      PRINT*,'relief aux points Viking pour les sorties:',phivik
+
+c----------------------------------------------------------------------
+c   lectures des etats:
+c   -------------------
+
+       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+       count_ps=(/iip1,jjp1,1/)
+       count_co2ice=(/iip1,jjp1,1/)
+       count_temp=(/iip1,jjp1,llm,1/)
+       
+       DO itau=1,nbpas
+
+       start_ps=(/1,1,itau/)
+       start_co2ice=(/1,1,itau/)
+       start_temp=(/1,1,1,itau/)
+c   lecture drs des champs:
+c   -----------------------
+c         varname='u'
+c         ierr=drsread (unitlec,varname,unat,itau)
+c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
+c         varname='v'
+c         ierr=drsread (unitlec,varname,vnat,itau)
+c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "ps", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <ps>'
+            CALL abort
+          ENDIF
+          
+          PRINT*,'ps',ps(iip1/2,jjp1/2)
+
+ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "temp", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
+#else
+          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <temp>'
+            ! Ehouarn: proceed anyways
+            ! CALL abort
+            write(*,*)'--> Setting temperature to zero !!!'
+            t(1:iip1,1:jjp1,1:llm)=0.0
+            write(*,*)'--> looking for temp7 (temp in 7th layer)'
+            ierr=NF_INQ_VARID(nid,"temp7", nvarid)
+            if (ierr.eq.NF_NOERR) then
+            write(*,*) "    OK, found temp7 variable"
+#ifdef NC_DOUBLE
+            ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start_ps,count_ps,t7)
+#else
+            ierr=NF_GET_VARA_REAL(nid,nvarid,start_ps,count_ps,t7)
+#endif
+              if (ierr.ne.NF_NOERR) then
+                write(*,*)'xvik: failed loading temp7 !'
+                stop
+              endif
+            else ! no 'temp7' variable
+              write(*,*)'  No temp7 variable either !'
+              write(*,*)'  Will have to to without ...'
+              t7(1:iip1,1:jjp1)=0.0
+            endif
+          ELSE ! t() was successfully loaded, copy 7th layer to t7()
+            t7(1:iip1,1:jjp1)=t(1:iip1,1:jjp1,7)
+          ENDIF
+
+c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
+     &    count_co2ice,  co2ice)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
+     &    count_co2ice, co2ice)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
+            CALL abort
+          ENDIF
+
+
+c Gestion du temps
+c ----------------
+          day=temps(itau)
+          PRINT*,'day ',day
+          CALL solarlong(day+day0,sollong)
+          sol=day+day0+461.
+          iyear=sol/unanj
+          WRITE (*,*) 'iyear',iyear
+          sol=sol-iyear*unanj
+c
+c Ouverture / fermeture des fichiers
+c ----------------------------------
+          IF (iyear.NE.kyear) THEN
+             WRITE(chr2(1:1),'(i1)') iyear+1
+             WRITE (*,*) 'iyear bis',iyear
+             WRITE (*,*) 'chr2'
+             WRITE (*,*)  chr2
+             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
+             kyear=iyear
+             DO ii=1,2
+                CLOSE(10+ifile(ii))
+                CLOSE(2+ifile(ii))
+                CLOSE(4+ifile(ii))
+                CLOSE(6+ifile(ii))
+                CLOSE(8+ifile(ii))
+                CLOSE(16+ifile(ii))
+                CLOSE(12+ifile(ii))
+                CLOSE(14+ifile(ii))
+                CLOSE(97)
+                CLOSE(98)
+             ENDDO
+             CLOSE(5+ifile(1))
+             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
+             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
+c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
+c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
+             IF(lcal) THEN
+c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
+c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
+c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
+             ENDIF
+                         IF(latcal) THEN
+c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
+c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
+                         ENDIF
+             IF(lvent) THEN
+c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
+c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
+c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
+c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
+             ENDIF
+             OPEN(97,file='xprestot'//chr2,form='formatted')
+c            OPEN(98,file='xlat37_'//chr2,form='formatted')
+           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
+          ENDIF
+ 
+
+          sollong=sollong*180./pi
+          IF(day_ls) THEN
+             dayw=sol
+             write(*,*) 'dayw', dayw
+          ELSE
+             dayw=sollong
+          ENDIF
+
+c Calcul de la moyenne planetaire
+c -------------------------------
+          pstot=0.
+          captotS=0.
+          captotN=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                pstot=pstot+aire(i,j)*ps(i,j)
+             ENDDO
+          ENDDO
+ 
+              DO j=1,jjp1/2
+                 DO i=1,iim
+                    captotN = captotN  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              DO j=jjp1/2+1, jjp1
+                 DO i=1,iim
+                    captotS = captotS  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
+     &       , captotN*g*airtot1, captotS*g*airtot1          
+
+          IF(.NOT.firstcal) THEN
+         WRITE(98,'(f5.1,16f7.3)')
+     s    dayw,(ps(i,37),i=1,iim,4)
+
+c boucle sur les sites vikings:
+c ----------------------------
+
+          DO iv=1,2
+
+c interpolation de la temperature dans la 7eme couche, de la pression
+c de surface et des vents aux points viking.
+
+             zp1=0.
+             zp2=0.
+             zp2_sm=0.
+             zt=0.
+             zu=0.
+             zv=0.
+             DO jj=0,1
+                j=jvik(iv)+jj
+                DO ii=0,1
+                   i=ivik(iv)+ii
+!                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
+                   zt=zt+zw(ii,jj,iv)*t7(i,j)
+!                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
+                   zp1=zp1+zw(ii,jj,iv)*log(ps(i,j)) ! interpolate in log(P)
+                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
+                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
+                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
+                ENDDO
+             ENDDO
+             zp1=exp(zp1) ! because of the bilinear interpolation in log(P)
+ 
+c               pression au sol extrapolee a partir de la temp. 7eme couche
+           WRITE (*,*) 'constR ',constR 
+           WRITE (*,*) 'zt ',zt
+             gh=constR*zt
+             if (gh.eq.0) then ! if we don't have temperature values
+               ! assume a scale height of 10km
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/(3.73*1.e4))
+             else
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
+             endif
+           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
+           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
+!           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
+           WRITE(ifile(iv)+10,'(3e15.5)') dayw,zp2,zp1
+           
+c   sorties eventuelles de vent
+             IF(lvent) THEN
+                WRITE(ifile(iv)+16,'(2e15.5)')
+     s          dayw,zu
+                WRITE(ifile(iv)+12,'(2e15.5)')
+     s          dayw,zv
+             ENDIF
+          ENDDO
+c         IF (lcal) THEN
+c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
+c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
+c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
+c         ENDIF
+c            IF(latcal) THEN
+c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
+c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
+c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
+c            ENDIF
+         ENDIF
+         firstcal=.false.
+
+c======================================================================
+c   Fin de la boucle sur les etats du fichier histoire:
+c======================================================================
+      ENDDO
+
+      ierr= NF_CLOSE(nid)
+
+      PRINT*,'Fin du fichier',nomfich
+      print*,'Entrer un nouveau fichier ou return pour finir'
+      READ(5,'(a)',err=9999) nomfich
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   Fin de la boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      ENDDO
+
+      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
+      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
+      DO iv=1,2
+         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
+         WRITE(6,7777)
+     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
+         print*
+         DO j=jvik(iv)-1,jvik(iv)+2
+            WRITE(6,'(f8.1,10x,5f7.1)')
+     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
+         ENDDO
+         print*
+         print*,'zw'
+         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
+         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
+      ENDDO
+      PRINT*,'R=',r
+ 9999  PRINT*,'Fin '
+
+7777  FORMAT ('latitude/longitude',4f7.1)
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Entries
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Entries	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Entries	(revision 46)
@@ -0,0 +1,10 @@
+/acc.F/1.1.1.1/Mon Nov 22 15:02:04 1999//Trel-1-0-patch
+/coefils.h/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/eigen.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/eigen_sort.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/filtreg.F/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+/inifgn.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/inifilr.F/1.1.1.1/Mon Nov 22 15:02:05 1999//Trel-1-0-patch
+/jacobi.F/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+/parafilt.h/1.2/Thu Mar 29 14:58:49 2001//Trel-1-0-patch
+D
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Repository
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Repository	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Repository	(revision 46)
@@ -0,0 +1,1 @@
+LMDZ.3.3/libf/filtrez
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Root
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Root	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Root	(revision 46)
@@ -0,0 +1,1 @@
+:pserver:lmdzbrowse@piaf.lmd.jussieu.fr:/users/lmdz/cvsroot
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Tag
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Tag	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/CVS/Tag	(revision 46)
@@ -0,0 +1,1 @@
+Trel-1-0-patch
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/acc.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/acc.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/acc.F	(revision 46)
@@ -0,0 +1,11 @@
+        subroutine acc(vec,d,im)
+        dimension vec(im,im),d(im)
+        do 10 j=1,im
+        do 9 i=1,im
+ 9	d(i)=vec(i,j)*vec(i,j)
+        sum=ssum(im,d,1)
+        sum=sqrt(sum)
+        do 10 i=1,im
+ 10	vec(i,j)=vec(i,j)/sum
+        return
+        end
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/coefils.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/coefils.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/coefils.h	(revision 46)
@@ -0,0 +1,8 @@
+      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
+     * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
+     * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
+     * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
+c
+      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
+      REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
+      REAL    coefilu2,coefilv2
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen.F	(revision 46)
@@ -0,0 +1,28 @@
+      SUBROUTINE eigen( e,d)
+#include "dimensions.h"
+      dimension e( iim,iim ), d( iim )
+      dimension asm( iim )
+      im=iim
+c
+      DO 48 i = 1,im
+	 asm( i ) = d( im-i+1 )
+ 48   CONTINUE
+      DO 49 i = 1,iim
+	 d( i ) = asm( i )
+ 49   CONTINUE
+c
+c     PRINT 70,d
+ 70   FORMAT(5x,'Valeurs propres',/,8(1x,8f10.4,/),/)
+		print *
+c
+      DO 51 i = 1,im
+	 DO 52 j = 1,im
+            asm( j ) = e( i , im-j+1 )
+ 52      CONTINUE
+	 DO 50 j = 1,im
+	    e( i,j ) = asm( j )
+ 50      CONTINUE
+ 51   CONTINUE
+
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen_sort.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen_sort.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/eigen_sort.F	(revision 46)
@@ -0,0 +1,29 @@
+          SUBROUTINE eigen_sort(d,v,n,np)
+          INTEGER n,np
+          REAL d(np),v(np,np)
+          INTEGER i,j,k
+          REAL p
+
+       DO i=1,n-1
+          k=i
+          p=d(i)
+        DO j=i+1,n
+           IF(d(j).ge.p) THEN
+            k=j
+            p=d(j)
+           ENDIF
+        ENDDO
+          
+        IF(k.ne.i) THEN
+          d(k)=d(i)
+          d(i)=p
+         DO j=1,n
+          p=v(j,i)
+          v(j,i)=v(j,k)
+          v(j,k)=p
+         ENDDO
+        ENDIF
+       ENDDO
+
+        RETURN
+        END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/filtreg.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/filtreg.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/filtreg.F	(revision 46)
@@ -0,0 +1,297 @@
+      SUBROUTINE filtreg ( champ, nlat, nbniv, ifiltre,iaire,
+     .   griscal ,iter)
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Auteur: P. Le Van        07/10/97
+c   ------
+c
+c   Objet: filtre matriciel longitudinal ,avec les matrices precalculees
+c                     pour l'operateur  Filtre    .
+c   ------
+c
+c   Arguments:
+c   ----------
+c
+c      nblat                 nombre de latitudes a filtrer
+c      nbniv                 nombre de niveaux verticaux a filtrer
+c      champ(iip1,nblat,nbniv)  en entree : champ a filtrer
+c                            en sortie : champ filtre
+c      ifiltre               +1  Transformee directe
+c                            -1  Transformee inverse
+c                            +2  Filtre directe
+c                            -2  Filtre inverse
+c
+c      iaire                 1   si champ intensif
+c                            2   si champ extensif (pondere par les aires)
+c
+c      iter                  1   filtre simple
+c
+c=======================================================================
+c
+c
+c                      Variable Intensive
+c                ifiltre = 1     filtre directe
+c                ifiltre =-1     filtre inverse
+c
+c                      Variable Extensive
+c                ifiltre = 2     filtre directe
+c                ifiltre =-2     filtre inverse
+c
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+#include "coefils.h"
+c
+      INTEGER nlat,nbniv,ifiltre,iter
+      INTEGER i,j,l,k
+      INTEGER iim2,immjm
+      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
+
+      REAL  champ( iip1,nlat,nbniv)
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
+     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
+     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+      REAL  eignq(iim), sdd1(iim),sdd2(iim)
+      LOGICAL    griscal
+      INTEGER    hemisph, iaire
+c
+
+      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1) 
+     *    STOP'Pas de transformee simple dans cette version'
+
+      IF( iter.EQ. 2 )  THEN
+       PRINT *,' Pas d iteration du filtre dans cette version !'
+     * , ' Utiliser old_filtreg et repasser !'
+           STOP
+      ENDIF
+
+      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
+       PRINT *,' Cette routine ne calcule le filtre inverse que ',
+     * ' sur la grille des scalaires !'
+           STOP
+      ENDIF
+
+      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
+       PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
+     *,' corriger et repasser !'
+           STOP
+      ENDIF
+c
+
+      iim2   = iim * iim
+      immjm  = iim * jjm
+c
+c
+      IF( griscal )   THEN
+         IF( nlat. NE. jjp1 )  THEN
+             PRINT  1111
+             STOP
+         ELSE
+c
+             IF( iaire.EQ.1 )  THEN
+                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 ) 
+                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
+             ELSE
+                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
+                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
+             END IF
+c
+             jdfil1 = 2
+             jffil1 = jfiltnu
+             jdfil2 = jfiltsu
+             jffil2 = jjm
+          END IF
+      ELSE
+          IF( nlat.NE.jjm )  THEN
+             PRINT  2222
+             STOP
+          ELSE
+c
+             IF( iaire.EQ.1 )  THEN
+                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 ) 
+                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
+             ELSE
+                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
+                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
+             END IF
+c
+             jdfil1 = 1
+             jffil1 = jfiltnv
+             jdfil2 = jfiltsv
+             jffil2 = jjm
+          END IF
+      END IF
+c
+c
+      DO 100  hemisph = 1, 2
+c
+      IF ( hemisph.EQ.1 )  THEN
+          jdfil = jdfil1
+          jffil = jffil1
+      ELSE
+          jdfil = jdfil2
+          jffil = jffil2
+      END IF
+
+ 
+      DO 50  l = 1, nbniv
+      DO 30  j = jdfil,jffil
+ 
+ 
+      DO  5  i = 1, iim
+      champ(i,j,l) = champ(i,j,l) * sdd1(i)
+   5  CONTINUE
+c
+
+      IF( hemisph. EQ. 1 )      THEN
+
+        IF( ifiltre. EQ. -2 )   THEN
+#ifdef CRAY
+         CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  , 
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO k = 1, iim
+      DO i = 1, iim
+         eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE IF ( griscal )     THEN
+#ifdef CRAY
+         CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE 
+#ifdef CRAY
+         CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq , 
+     *                             1, iim, iim                         )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ENDIF
+
+      ELSE
+
+        IF( ifiltre. EQ. -2 )   THEN
+#ifdef CRAY
+         CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 ,  
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE IF ( griscal )     THEN
+#ifdef CRAY
+         CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 , 
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ELSE 
+#ifdef CRAY
+         CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 , 
+     *                          eignq,  1, iim, iim                    )
+#else
+#ifdef BLAS
+      CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
+     .           champ(1,j,l), 1, 0.0, eignq, 1)
+#else
+      DO k = 1, iim
+         eignq(k) = 0.0
+      ENDDO
+      DO i = 1, iim
+      DO k = 1, iim
+         eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
+      ENDDO
+      ENDDO
+#endif
+#endif
+        ENDIF
+
+      ENDIF
+c
+      IF( ifiltre.EQ. 2 )  THEN
+        DO 15 i = 1, iim
+        champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
+  15    CONTINUE
+      ELSE
+        DO 16 i=1,iim
+        champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
+16      CONTINUE
+      ENDIF
+c
+      champ( iip1,j,l ) = champ( 1,j,l )
+c
+  30  CONTINUE
+c
+  50  CONTINUE
+c    
+ 100  CONTINUE
+c
+1111  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a 
+     *filtrer, sur la grille des scalaires'/)
+2222  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
+     *ltrer, sur la grille de V ou de Z'/)
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifgn.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifgn.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifgn.F	(revision 46)
@@ -0,0 +1,103 @@
+      SUBROUTINE inifgn(dv)
+c  
+c    ...  H.Upadyaya , O.Sharma  ... 
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "serre.h"
+
+c
+      REAL vec(iim,iim),vec1(iim,iim)
+      REAL dlonu(iim),dlonv(iim)
+      REAL du(iim),dv(iim),d(iim)
+      REAL pi
+      INTEGER i,j,k,imm1,nrot
+C
+#include "coefils.h"
+c
+      EXTERNAL SSUM, acc,eigen,jacobi
+      REAL SSUM
+c
+
+      imm1  = iim -1
+      pi = 2.* ASIN(1.)
+C
+      DO 5 i=1,iim
+       dlonu(i)=  xprimu( i )
+       dlonv(i)=  xprimv( i )
+   5  CONTINUE
+
+      DO 12 i=1,iim
+      sddv(i)   = SQRT(dlonv(i))
+      sddu(i)   = SQRT(dlonu(i))
+      unsddu(i) = 1./sddu(i)
+      unsddv(i) = 1./sddv(i)
+  12  CONTINUE
+C
+      DO 17 j=1,iim
+      DO 17 i=1,iim
+      vec(i,j)     = 0.
+      vec1(i,j)    = 0.
+      eignfnv(i,j) = 0.
+      eignfnu(i,j) = 0.
+  17  CONTINUE
+c
+c
+      eignfnv(1,1)    = -1.
+      eignfnv(iim,1)  =  1.
+      DO 20 i=1,imm1
+      eignfnv(i+1,i+1)= -1.
+      eignfnv(i,i+1)  =  1.
+  20  CONTINUE
+      DO 25 j=1,iim
+      DO 25 i=1,iim
+      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
+  25  CONTINUE
+      DO 30 j=1,iim
+      DO 30 i=1,iim
+      eignfnu(i,j) = -eignfnv(j,i)
+  30  CONTINUE
+c
+#ifdef CRAY
+      CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
+      CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
+#else
+      DO j = 1, iim
+      DO i = 1, iim
+        vec (i,j) = 0.0
+        vec1(i,j) = 0.0
+       DO k = 1, iim
+        vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
+        vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
+       ENDDO
+      ENDDO
+      ENDDO
+#endif
+
+c
+      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
+      CALL acc(eignfnv,d,iim)
+      CALL eigen_sort(dv,eignfnv,iim,iim)
+c
+      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
+      CALL acc(eignfnu,d,iim)
+      CALL eigen_sort(du,eignfnu,iim,iim)
+
+cc   ancienne version avec appels IMSL
+c
+c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
+c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
+c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
+c     CALL acc(eignfnv,d,iim)
+c     CALL eigen(eignfnv,dv)
+c
+c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
+c     CALL acc(eignfnu,d,iim)
+c     CALL eigen(eignfnu,du)
+
+      RETURN
+      END
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifilr.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifilr.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/inifilr.F	(revision 46)
@@ -0,0 +1,584 @@
+      SUBROUTINE inifilr
+c
+c    ... H. Upadhyaya, O.Sharma   ...
+c
+      IMPLICIT NONE
+c
+c     version 3 .....
+
+c     Correction  le 28/10/97    P. Le Van .
+c  -------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+c  -------------------------------------------------------------------
+#include "comgeom.h"
+#include "coefils.h"
+#include "logic.h"
+#include "serre.h"
+
+      REAL  dlonu(iim),dlatu(jjm)
+      REAL  rlamda( iim ),  eignvl( iim )
+c
+
+      REAL    lamdamax,pi,cof
+      INTEGER i,j,modemax,imx,k,kf,ii
+      REAL dymin,dxmin,colat0
+      REAL eignft(iim,iim), coff
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
+     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
+     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+#ifdef CRAY
+      INTEGER   ISMIN
+      EXTERNAL  ISMIN
+      INTEGER iymin 
+      INTEGER ixmineq
+#endif
+      EXTERNAL  inifgn
+c
+c ------------------------------------------------------------
+c   This routine computes the eigenfunctions of the laplacien
+c   on the stretched grid, and the filtering coefficients
+c      
+c  We designate:
+c   eignfn   eigenfunctions of the discrete laplacien
+c   eigenvl  eigenvalues
+c   jfiltn   indexof the last scalar line filtered in NH
+c   jfilts   index of the first line filtered in SH
+c   modfrst  index of the mode from where modes are filtered
+c   modemax  maximum number of modes ( im )
+c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
+c   sdd      SQRT( dx )
+c      
+c     the modes are filtered from modfrst to modemax
+c      
+c-----------------------------------------------------------
+c
+
+       pi       = 2. * ASIN( 1. )
+
+       DO i = 1,iim
+        dlonu(i) = xprimu( i )
+       ENDDO
+c
+       CALL inifgn(eignvl)
+c
+        print *,' EIGNVL '
+        PRINT 250,eignvl
+250     FORMAT( 1x,5e13.6)
+c
+c compute eigenvalues and eigenfunctions
+c
+c
+c.................................................................
+c
+c  compute the filtering coefficients for scalar lines and 
+c  meridional wind v-lines
+c
+c  we filter all those latitude lines where coefil < 1
+c  NO FILTERING AT POLES
+c
+c  colat0 is to be used  when alpha (stretching coefficient)
+c  is set equal to zero for the regular grid case 
+c
+c    .......   Calcul  de  colat0   .........
+c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
+c
+c
+      DO 45 j = 1,jjm
+         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
+ 45   CONTINUE
+c
+#ifdef CRAY
+      iymin   = ISMIN( jjm, dlatu, 1 )
+      ixmineq = ISMIN( iim, dlonu, 1 )
+      dymin   = dlatu( iymin )
+      dxmin   = dlonu( ixmineq )
+#else
+      dxmin   =  dlonu(1)
+       DO  i  = 2, iim
+        dxmin = MIN( dxmin,dlonu(i) )
+       ENDDO
+      dymin  = dlatu(1)
+       DO j  = 2, jjm
+        dymin = MIN( dymin,dlatu(j) )
+       ENDDO
+#endif
+c
+c
+      colat0  =  MIN( 0.5, dymin/dxmin )
+c
+      IF( .NOT.fxyhypb.AND.ysinus )  THEN
+           colat0 = 0.6
+c         ...... a revoir  pour  ysinus !   .......
+           alphax = 0.
+      ENDIF
+c
+      PRINT 50, colat0,alphax
+  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
+c
+      IF(alphax.EQ.1. )  THEN
+        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
+         STOP
+      ENDIF
+c
+      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
+
+cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
+c
+      DO 71 i = 2,iim
+       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
+ 71   CONTINUE
+c
+
+      DO 72 j = 1,jjm
+	    DO 73 i = 1,iim
+	    coefilu( i,j )  = 0.0
+	    coefilv( i,j )  = 0.0
+	    coefilu2( i,j ) = 0.0
+	    coefilv2( i,j ) = 0.0
+ 73     CONTINUE
+ 72   CONTINUE
+
+c
+c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
+c    .........................................................
+c
+       modemax = iim
+
+cccc    imx = modemax - 4 * (modemax/iim)
+
+       imx  = iim
+c
+       PRINT *,' TRUNCATION AT ',imx
+c
+      DO 75 j = 2, jjm/2+1
+       cof = COS( rlatu(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+        ENDIF
+
+       cof = COS( rlatu(jjp1-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
+     $      jfiltsu= jjp1-j+1
+        ENDIF
+ 75   CONTINUE
+c
+      DO 76 j = 1, jjm/2
+       cof = COS( rlatv(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+        ENDIF
+
+       cof = COS( rlatv(jjm-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
+     $       jfiltsv= jjm-j+1
+        ENDIF
+ 76   CONTINUE
+c                                 
+
+      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
+        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
+        STOP
+      ENDIF
+
+      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
+        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
+        STOP
+      ENDIF
+
+      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
+        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
+        STOP
+      ENDIF
+
+      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
+        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
+        STOP
+      ENDIF
+
+       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
+     *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
+
+c                                 
+c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
+c................................................................
+c
+c
+      DO 77 j = 1,jjm
+	  modfrstu( j ) = iim
+	  modfrstv( j ) = iim
+ 77   CONTINUE
+c
+      DO 84 j = 2,jfiltnu
+       DO 81 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 82
+ 81    CONTINUE
+      GOTO 84
+ 82   modfrstu( j ) = k
+c
+	  kf = modfrstu( j )
+	   DO 83 k = kf , modemax
+        cof = rlamda(k) * COS( rlatu(j) )
+	    coefilu(k,j) = cof - 1.
+	    coefilu2(k,j) = cof*cof - 1.
+ 83    CONTINUE
+ 84   CONTINUE
+c                                 
+c
+      DO 89 j = 1,jfiltnv
+c
+       DO 86 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 87
+ 86    CONTINUE
+      GOTO 89
+ 87   modfrstv( j ) = k
+c
+	   kf = modfrstv( j )
+	   DO 88 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 88    CONTINUE
+c
+ 89    CONTINUE
+c
+      DO 94 j = jfiltsu,jjm
+       DO 91 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 92
+ 91    CONTINUE
+      GOTO 94
+ 92   modfrstu( j ) = k
+c
+        kf = modfrstu( j )
+	 DO 93 k = kf , modemax
+          cof = rlamda(k) * COS( rlatu(j) )
+	  coefilu(k,j) = cof - 1.
+	  coefilu2(k,j) = cof*cof - 1.
+ 93      CONTINUE
+ 94    CONTINUE
+c                                 
+      DO 99 j = jfiltsv,jjm
+       DO 96 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 97
+ 96    CONTINUE
+      GOTO 99
+ 97   modfrstv( j ) = k
+c
+       kf = modfrstv( j )
+	   DO 98 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 98    CONTINUE
+ 99   CONTINUE
+c
+
+       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
+
+         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
+         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
+
+          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
+     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
+       ENDIF
+
+       PRINT *,'   Modes premiers  v  '
+       PRINT 334,modfrstv
+       PRINT *,'   Modes premiers  u  '
+       PRINT 334,modfrstu
+
+     
+      IF( nfilun.LT. jfiltnu )  THEN
+       PRINT *,' le parametre nfilun utilise pour la matrice ',
+     *   ' matriceun  est trop petit ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilun.GT. jfiltnu+ 2 )  THEN
+           PRINT *,' le parametre nfilun utilise pour la matrice ',
+     *' matriceun est trop grand ! Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
+            PRINT *,' le parametre nfilus utilise pour la matrice ',
+     *   ' matriceus  est trop petit !  '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ',
+     * jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
+           PRINT *,' le parametre nfilus utilise pour la matrice ',
+     * ' matriceus  est trop grand ! ' 
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
+     * jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilvn.LT. jfiltnv )  THEN
+            PRINT *,' le parametre nfilvn utilise pour la matrice ',
+     *   ' matricevn  est trop petit ! '  
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
+           PRINT *,' le parametre nfilvn utilise pour la matrice ',
+     *' matricevn est trop grand !  Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
+            PRINT *,' le parametre nfilvs utilise pour la matrice ',
+     *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  '
+     * , jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
+           PRINT *,' le parametre nfilvs utilise pour la matrice ',
+     * ' matricevs  est trop grand ! Gachis de memoire ! '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  '
+     *   ,  jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
+     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
+     *  ,jfiltnv,jjm-jfiltsv+1
+c              STOP
+      ENDIF
+
+c  
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
+c                       sur la grille scalaire                 ........
+c   ...................................................................
+c
+        DO j = 2, jfiltnu
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
+#else
+#ifdef BLAS
+         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceun(i,k,j) = 0.0
+            DO ii = 1, iim
+               matriceun(i,k,j) = matriceun(i,k,j)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $           eignfnv, iim, eignft, iim, 0.0, 
+     $           matriceus(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceus(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
+     .                                    + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
+c                       sur la grille   de V ou de Z           ........
+c   ...................................................................
+c
+        DO j = 1, jfiltnv
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+           DO k = 1, iim
+            eignft(i,k) = eignfnu(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matricevn(i,k,j) = matricevn(i,k,j)
+     .                          + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsv, jjm
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+            DO k = 1, iim
+             eignft(i,k) = eignfnu(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $           eignfnu, iim, eignft, iim, 0.0, 
+     $           matricevs(1,1,j-jfiltsv+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevs(i,k,j-jfiltsv+1) = 0.0
+            DO ii = 1, iim
+               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
+     .                          + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+c
+c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
+c              sur la grille scalaire , pour le filtre inverse ........
+c   ...................................................................
+c
+        DO j = 2, jfiltnu
+
+         DO i = 1,iim
+          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matrinvn(i,k,j) = matrinvn(i,k,j)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i = 1,iim
+          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
+     $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvs(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
+     .                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+c   ...................................................................
+
+c
+334    FORMAT(1x,24i3)
+755    FORMAT(1x,6f10.3,i3)
+
+       RETURN
+       END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/jacobi.F
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/jacobi.F	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/jacobi.F	(revision 46)
@@ -0,0 +1,94 @@
+      SUBROUTINE JACOBI(A,N,NP,D,V,NROT)
+      PARAMETER (NMAX=400)
+      DIMENSION A(NP,NP),D(NP),V(NP,NP),B(NMAX),Z(NMAX)
+      IF (n.gt.nmax) THEN
+         print*, 'n, nmax=', n, nmax
+         print*, 'Surdimensionnement insuffisant dans jacobi'
+         CALL abort
+      ENDIF
+      DO 12 IP=1,N
+        DO 11 IQ=1,N
+          V(IP,IQ)=0.
+11      CONTINUE
+        V(IP,IP)=1.
+12    CONTINUE
+      DO 13 IP=1,N
+        B(IP)=A(IP,IP)
+        D(IP)=B(IP)
+        Z(IP)=0.
+13    CONTINUE
+      NROT=0
+      DO 24 I=1,50
+        SM=0.
+        DO 15 IP=1,N-1
+          DO 14 IQ=IP+1,N
+            SM=SM+ABS(A(IP,IQ))
+14        CONTINUE
+15      CONTINUE
+        IF(SM.EQ.0.)RETURN
+        IF(I.LT.4)THEN
+          TRESH=0.2*SM/N**2
+        ELSE
+          TRESH=0.
+        ENDIF
+        DO 22 IP=1,N-1
+          DO 21 IQ=IP+1,N
+            G=100.*ABS(A(IP,IQ))
+            IF((I.GT.4).AND.(ABS(D(IP))+G.EQ.ABS(D(IP)))
+     *         .AND.(ABS(D(IQ))+G.EQ.ABS(D(IQ))))THEN
+              A(IP,IQ)=0.
+            ELSE IF(ABS(A(IP,IQ)).GT.TRESH)THEN
+              H=D(IQ)-D(IP)
+              IF(ABS(H)+G.EQ.ABS(H))THEN
+                T=A(IP,IQ)/H
+              ELSE
+                THETA=0.5*H/A(IP,IQ)
+                T=1./(ABS(THETA)+SQRT(1.+THETA**2))
+                IF(THETA.LT.0.)T=-T
+              ENDIF
+              C=1./SQRT(1+T**2)
+              S=T*C
+              TAU=S/(1.+C)
+              H=T*A(IP,IQ)
+              Z(IP)=Z(IP)-H
+              Z(IQ)=Z(IQ)+H
+              D(IP)=D(IP)-H
+              D(IQ)=D(IQ)+H
+              A(IP,IQ)=0.
+              DO 16 J=1,IP-1
+                G=A(J,IP)
+                H=A(J,IQ)
+                A(J,IP)=G-S*(H+G*TAU)
+                A(J,IQ)=H+S*(G-H*TAU)
+16            CONTINUE
+              DO 17 J=IP+1,IQ-1
+                G=A(IP,J)
+                H=A(J,IQ)
+                A(IP,J)=G-S*(H+G*TAU)
+                A(J,IQ)=H+S*(G-H*TAU)
+17            CONTINUE
+              DO 18 J=IQ+1,N
+                G=A(IP,J)
+                H=A(IQ,J)
+                A(IP,J)=G-S*(H+G*TAU)
+                A(IQ,J)=H+S*(G-H*TAU)
+18            CONTINUE
+              DO 19 J=1,N
+                G=V(J,IP)
+                H=V(J,IQ)
+                V(J,IP)=G-S*(H+G*TAU)
+                V(J,IQ)=H+S*(G-H*TAU)
+19            CONTINUE
+              NROT=NROT+1
+            ENDIF
+21        CONTINUE
+22      CONTINUE
+        DO 23 IP=1,N
+          B(IP)=B(IP)+Z(IP)
+          D(IP)=B(IP)
+          Z(IP)=0.
+23      CONTINUE
+24    CONTINUE
+      STOP '50 iterations should never happen'
+      RETURN
+      END
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/parafilt.h
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/parafilt.h	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/filtrez/parafilt.h	(revision 46)
@@ -0,0 +1,40 @@
+        INTEGER nfilun, nfilus, nfilvn, nfilvs
+c
+c 48 32 19 non-zoom:
+c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
+c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
+c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
+c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
+cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
+c
+c
+c 96 49 11 non-zoom:
+ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
+c
+c
+c 144 73 11 non-zoom:
+ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
+c
+c 192 143 19 non-zoom:
+c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
+c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
+c      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
+!!        PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
+        PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
+c 96 72 19 non-zoom:
+ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
+c
+c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
+c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
+c
+c
+c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
+c
+c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
+c
+c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
+c
+c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
+c
+c      Parameter  ci-dessus  et de relancer  le  run .  
+
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.1.1.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.10.48.55.t6	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 10
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=55
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=6
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.25.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.24.32.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=32
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.16.32.25.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 16
+      INTEGER, parameter :: jjm=32
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.176.90.18.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 176
+      INTEGER, parameter :: jjm=90
+      INTEGER, parameter :: llm=18
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.2.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.2.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.2.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=2
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t32
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t32	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.25.t32	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=32
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.256.180.18.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.256.180.18.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.256.180.18.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 256
+      INTEGER, parameter :: jjm=180
+      INTEGER, parameter :: llm=18
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.25.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.25.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.25.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.26.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.26.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.26.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=26
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.32.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t13	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=13
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.50.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t12	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=12
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.24.60.t60	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=24
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=60
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.34.60.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 32
+      INTEGER, parameter :: jjm=34
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.32.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.18.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.18.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.18.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 352
+      INTEGER, parameter :: jjm=180
+      INTEGER, parameter :: llm=18
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.36.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.36.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.352.180.36.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 352
+      INTEGER, parameter :: jjm=180
+      INTEGER, parameter :: llm=36
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.50.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.18.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.18.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.18.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=18
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.24.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=24
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t-p	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=-p
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.25.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=25
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t12	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=12
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t13	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=13
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t4
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t4	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.32.t4	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=4
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.325.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=325
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t1	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.50.t15	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=50
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=15
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t14	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=54
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=14
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.64.48.54.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 64
+      INTEGER, parameter :: jjm=48
+      INTEGER, parameter :: llm=54
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/dimensions.72.36.32.t2	(revision 46)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h continet les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 72
+      INTEGER, parameter :: jjm=36
+      INTEGER, parameter :: llm=32
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=2
+
+!-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.bak
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.bak	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.bak	(revision 46)
@@ -0,0 +1,63 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+ if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+ else if [ $# -ge 2 ] ; then
+      im=1
+      jm=$1
+      lm=$2
+      ndm=1
+ else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+ else
+         echo il faut au moins une dimension
+         exit
+ fi
+fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.moi
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.moi	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.moi	(revision 46)
@@ -0,0 +1,68 @@
+nqmx=$1
+shift
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions${list}.t${nqmx}
+
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+echo $#
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+
+#  while [ "$n2" -gt 2 ]; do
+#      n2=`expr $n2 / 2`
+#     ndm=`expr $ndm + 1`
+#   done
+#   if [ "$n2" != 2 ] ; then
+#      echo le nombre de longitude doit etre une puissance de 2
+#      exit
+#   fi
+
+echo $#
+    if [ $# -ge 2 ] ; then
+      im=1
+       jm=$1
+      lm=$2
+      ndm=1
+      else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+      else
+         echo il faut au moins une dimension
+         exit
+      fi
+    fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.n
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.n	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.n	(revision 46)
@@ -0,0 +1,65 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 4 ] ; then
+   nqmx=$1
+   im=$2
+   jm=$3
+   lm=$4
+   n2=$2
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+else if [ $# -ge 3 ] ; then
+   nqmx=$1
+   im=1
+   jm=$2
+   lm=$3
+   ndm=1
+   else if [ $# -ge 2 ] ; then
+      nqmx=$1
+      im=1
+      jm=1
+      lm=$2
+      ndm=1
+   else
+      echo il faut au moins une dimension
+      exit
+   fi
+fi
+
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les dimensions du modele
+c   ndm est tel que iim=2**ndm
+c   nqmx est la dimension de la variable traceur q
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+      integer nqmx
+      parameter (nqmx=$nqmx)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.old
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.old	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdim.old	(revision 46)
@@ -0,0 +1,57 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimensions$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+   n2=$1
+   ndm=1
+   while [ "$n2" -gt 2 ]; do
+      n2=`expr $n2 / 2`
+      ndm=`expr $ndm + 1`
+   done
+   if [ "$n2" != 2 ] ; then
+      echo le nombre de longitude doit etre une puissance de 2
+      exit
+   fi
+   else if [ $# -ge 2 ] ; then
+      im=1
+      jm=$1
+      lm=$2
+      ndm=1
+      else if [ $# -ge 1 ] ; then
+         im=1
+         jm=1
+         lm=$1
+         ndm=1
+      else
+         echo il faut au moins une dimension
+         exit
+      fi
+   fi
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+c   INCLUDE 'dimensions.h'
+c
+c   dimensions.h continet les trois dimensions du modele
+c   ndm est tel que iim=2**ndm
+c-----------------------------------------------------------------------
+
+      INTEGER iim,jjm,llm,ndm
+
+      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../dimensions.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimensions.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdimphy
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdimphy	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makdimphy	(revision 46)
@@ -0,0 +1,28 @@
+for i in $* ; do
+   list=$list.$i
+done
+fichdim=dimphy$list
+
+if [ ! -f $fichdim ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+if [ $# -ge 3 ] ; then
+   im=$1
+   jm=$2
+   lm=$3
+else
+   echo il faut preciser les dimensions
+   exit
+fi
+
+cat << EOF > $fichdim
+c-----------------------------------------------------------------------
+      INTEGER KIDIA, KFDIA, KLON, KLEV
+      PARAMETER (KIDIA=1,KFDIA=$im*($jm-1)+2,
+     .           KLON=KFDIA-KIDIA+1,KLEV=$lm)
+c-----------------------------------------------------------------------
+EOF
+fi
+
+/bin/rm ../dimphy.h
+tar cf - $fichdim | ( cd .. ; tar xf - ; mv $fichdim dimphy.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makntrac
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makntrac	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/makntrac	(revision 46)
@@ -0,0 +1,23 @@
+fichntrac=ntraceur.$1
+
+if [ ! -f $fichntrac ] ; then
+# si le fichier de dimensions n'existe pas, on le cree
+
+cat << EOF > $fichntrac
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=$1)
+
+c-----------------------------------------------------------------------
+EOF
+fi
+
+\rm ../ntraceur.h
+tar cf - $fichntrac | ( cd .. ; tar xf - ; mv $fichntrac ntraceur.h )
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.1
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.1	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.1	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=1)
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.5
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.5	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libf/zz_not_used/grid/dimension/ntraceur.5	(revision 46)
@@ -0,0 +1,12 @@
+c-----------------------------------------------------------------------
+c   INCLUDE 'ntraceur.h'
+c
+c   ntraceur.h contient la dimension de la variable traceur q
+c   Generalement egale au nombre de traceur.
+c-----------------------------------------------------------------------
+
+      INTEGER nqmx
+
+      PARAMETER (nqmx=5)
+
+c-----------------------------------------------------------------------
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/liblmd_content
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/liblmd_content	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/liblmd_content	(revision 46)
@@ -0,0 +1,9013 @@
+
+aerave.o:
+00000000 b .BSS1
+00000010 d .C1_287
+0000000c d .C1_288
+00000008 d .C1_290
+00000000 d .C1_352
+00000004 d .C1_428
+0000056d t __aerave_END
+00000010 T aerave_
+         U blackl_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+
+aeropacity.o:
+00000000 b .BSS1
+00000150 d .C1_283
+00000174 d .C1_285
+000001a8 d .C1_287
+000001ec d .C1_288
+000001e8 d .C1_290
+00000148 d .C1_327
+00000170 d .C1_328
+0000016c d .C1_405
+00000000 d .C1_602
+00000055 d .C1_603
+00000128 d .C1_605
+00000004 d .C1_606
+0000014c d .C1_610
+00000138 d .C1_611
+000001c0 d .C1_613
+0000012c d .C1_614
+00000130 d .C1_615
+00000016 d .C1_616
+00000134 d .C1_617
+00000043 d .C1_618
+00000140 d .C1_621
+0000004d d .C1_622
+00000144 d .C1_624
+000000ae d .C1_625
+000000bd d .C1_626
+00000158 d .C1_628
+0000018c d .C1_630
+000001c4 d .C1_631
+00000188 d .C1_632
+000001d8 d .C1_633
+000001c8 d .C1_634
+000001cc d .C1_635
+000001d4 d .C1_636
+000001d0 d .C1_637
+000001dc d .C1_638
+000001e0 d .C1_639
+000001f0 d .C1_644
+000001f4 d .C1_645
+00000101 d .C1_646
+00000154 d .C1_648
+000001b8 d .C1_650
+000001bc d .C1_651
+000001b4 d .C1_652
+00000178 d .C1_653
+00000164 d .C1_654
+0000015c d .C1_655
+00000160 d .C1_656
+00000180 d .C1_657
+000000c3 d .C1_659
+000000cd d .C1_660
+000000ee d .C1_661
+000000f5 d .C1_664
+000000ff d .C1_665
+0000017c d .C1_667
+00000190 d .C1_669
+00000194 d .C1_670
+00000198 d .C1_671
+0000019c d .C1_672
+000001a0 d .C1_673
+000001a4 d .C1_674
+000001b0 d .C1_675
+000001ac d .C1_676
+000000d8 d .C1_678
+000000de d .C1_679
+000000ef d .C1_680
+0000013c d .C1_922
+000001f8 d .C1_947
+000001e4 d .C1_953
+00000168 d .C1_972
+00000184 d .C1_982
+00000200 d .STATICS1
+0000330e t __aeropacity_END
+         U __mth_i_cosx
+         U __mth_i_expx
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+         U __mth_i_sinx
+         U __mth_i_tanhx
+00000010 T aeropacity_
+000000c0 C callkeys_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_strcmp
+         U ioipsl_errioipsl_
+00000014 C ioipsl_errioipsl_12_
+         U ioipsl_getincom_
+0000002c C ioipsl_getincom_12_
+00000006 C ioipsl_getincom_13_
+000002b4 C ioipsl_getincom_4_
+00002710 C ioipsl_getincom_5_
+         U ioipsl_getincom_getinrs_
+         U ioipsl_stringop_
+00000078 C ioipsl_stringop_8_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U pghpfio_ldw
+00000038 C planet_
+         U readtesassim_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U writediagfi_
+         U writeg1d_
+         U wstats_
+0000006c C yomaer_
+         U zerophys_
+
+aeroptproperties.o:
+00000000 b .BSS1
+0000003c d .C1_1020
+00000000 d .C1_1223
+00000028 d .C1_285
+00000048 d .C1_287
+00000050 d .C1_288
+0000004c d .C1_290
+00000024 d .C1_392
+0000002c d .C1_394
+00000018 d .C1_419
+00000034 d .C1_420
+00000010 d .C1_521
+00000040 d .C1_524
+00000014 d .C1_525
+00000044 d .C1_530
+00000038 d .C1_532
+00000030 d .C1_557
+00000020 d .C1_560
+0000001c d .C1_886
+00000058 d .STATICS1
+00005a98 t __aeroptproperties_END
+         U __mth_i_alogx
+         U __mth_i_asinx
+         U __mth_i_expx
+         U __mth_i_rpowrx
+00000010 T aeroptproperties_
+000000c0 C callkeys_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_floor
+         U pgf90_template1v
+         U pghpf_minloc
+0000006c C yomaer_
+
+assim_aeropacity.o:
+00000000 b .BSS1
+00000154 d .C1_283
+00000178 d .C1_285
+000001ac d .C1_287
+000001f0 d .C1_288
+000001ec d .C1_290
+0000014c d .C1_327
+00000174 d .C1_328
+00000170 d .C1_405
+00000000 d .C1_602
+00000055 d .C1_603
+0000012c d .C1_605
+00000004 d .C1_606
+00000150 d .C1_610
+0000013c d .C1_611
+000001c4 d .C1_613
+00000130 d .C1_614
+00000134 d .C1_615
+00000016 d .C1_616
+00000138 d .C1_617
+00000043 d .C1_618
+00000144 d .C1_621
+0000004d d .C1_622
+00000148 d .C1_624
+000000b4 d .C1_625
+000000c3 d .C1_626
+0000015c d .C1_628
+00000190 d .C1_630
+000001c8 d .C1_631
+0000018c d .C1_632
+000001dc d .C1_633
+000001cc d .C1_634
+000001d0 d .C1_635
+000001d8 d .C1_636
+000001d4 d .C1_637
+000001e0 d .C1_638
+000001e4 d .C1_639
+000001f4 d .C1_644
+000001f8 d .C1_645
+00000107 d .C1_648
+00000158 d .C1_650
+000001bc d .C1_652
+000001c0 d .C1_653
+000001b8 d .C1_654
+0000017c d .C1_655
+00000168 d .C1_656
+00000160 d .C1_657
+00000164 d .C1_658
+00000184 d .C1_659
+000000c9 d .C1_661
+000000d3 d .C1_662
+000000f4 d .C1_663
+000000fb d .C1_666
+00000105 d .C1_667
+00000180 d .C1_669
+00000194 d .C1_671
+00000198 d .C1_672
+0000019c d .C1_673
+000001a0 d .C1_674
+000001a4 d .C1_675
+000001a8 d .C1_676
+000001b4 d .C1_677
+000001b0 d .C1_678
+000000de d .C1_680
+000000e4 d .C1_681
+000000f5 d .C1_682
+00000140 d .C1_925
+000001fc d .C1_950
+000001e8 d .C1_956
+0000016c d .C1_975
+00000188 d .C1_985
+00000200 d .STATICS1
+0000336f t __aeropacity_END
+         U __mth_i_cosx
+         U __mth_i_expx
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+         U __mth_i_sinx
+         U __mth_i_tanhx
+00000010 T aeropacity_
+000000c0 C callkeys_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_strcmp
+         U ioipsl_errioipsl_
+00000014 C ioipsl_errioipsl_12_
+         U ioipsl_getincom_
+0000002c C ioipsl_getincom_12_
+00000006 C ioipsl_getincom_13_
+000002b4 C ioipsl_getincom_4_
+00002710 C ioipsl_getincom_5_
+         U ioipsl_getincom_getinrs_
+         U ioipsl_stringop_
+00000078 C ioipsl_stringop_8_
+         U meso_readtesassim_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U pghpfio_ldw
+00000038 C planet_
+         U readtesassim_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U writediagfi_
+         U writeg1d_
+         U wstats_
+0000006c C yomaer_
+         U zerophys_
+
+assim_readtesassim.o:
+00000000 b .BSS1
+000002f4 d .C1_283
+000002f0 d .C1_285
+000002cc d .C1_287
+000002c8 d .C1_288
+00000268 d .C1_340
+000002e4 d .C1_341
+000002e8 d .C1_342
+00000260 d .C1_680
+00000288 d .C1_681
+000002a8 d .C1_682
+00000000 d .C1_685
+000001f7 d .C1_686
+00000264 d .C1_688
+00000014 d .C1_689
+0000006c d .C1_695
+000000ca d .C1_696
+000000f5 d .C1_697
+0000003a d .C1_702
+0000026c d .C1_703
+00000043 d .C1_704
+00000270 d .C1_706
+00000274 d .C1_707
+00000070 d .C1_708
+00000278 d .C1_709
+000002ec d .C1_710
+00000094 d .C1_711
+0000027c d .C1_712
+000000af d .C1_713
+000002a0 d .C1_714
+00000280 d .C1_715
+000000cd d .C1_716
+00000284 d .C1_717
+000000f8 d .C1_718
+000002a4 d .C1_719
+0000028c d .C1_723
+00000121 d .C1_724
+00000290 d .C1_725
+0000014f d .C1_726
+00000294 d .C1_727
+00000155 d .C1_728
+00000298 d .C1_729
+0000015b d .C1_730
+0000029c d .C1_731
+00000161 d .C1_732
+000002ac d .C1_734
+00000167 d .C1_735
+000002b0 d .C1_736
+00000188 d .C1_737
+000002b4 d .C1_738
+0000018e d .C1_739
+000002b8 d .C1_740
+00000199 d .C1_741
+000002bc d .C1_742
+000001a4 d .C1_743
+000002c0 d .C1_744
+000001a9 d .C1_745
+000002c4 d .C1_746
+000001ae d .C1_747
+000002d0 d .C1_748
+000001b2 d .C1_749
+000002d4 d .C1_750
+000001e6 d .C1_751
+000002d8 d .C1_752
+000001ec d .C1_753
+000002dc d .C1_754
+000001f1 d .C1_755
+000002e0 d .C1_756
+0000025a d .C1_757
+000002f8 d .C1_758
+00000300 d .STATICS1
+00001e30 t __meso_readtesassim_END
+         U __mth_i_acosx
+         U __mth_i_amodx
+         U abort_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U lnblnk_
+00000010 T meso_readtesassim_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+blackl.o:
+00000028 d .C1_292
+00000000 d .C1_300
+00000008 d .C1_302
+00000010 d .C1_304
+00000018 d .C1_306
+00000020 d .C1_308
+000000d5 t __blackl_END
+         U __mth_i_datanx
+         U __mth_i_dexpx
+00000010 T blackl_
+         U pgf90_compiled
+
+blendrad.o:
+00000004 d .C1_288
+00000000 d .C1_420
+00000163 t __blendrad_END
+00000010 T blendrad_
+06b3a000 C ksicom_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+calchim.o:
+00000000 b .BSS1
+0000043c d .C1_1005
+0000042c d .C1_1007
+0000044c d .C1_283
+00000448 d .C1_285
+00000454 d .C1_321
+00000420 d .C1_337
+00000458 d .C1_351
+000003ac d .C1_355
+00000450 d .C1_364
+00000444 d .C1_478
+00000311 d .C1_530
+00000390 d .C1_532
+00000414 d .C1_533
+00000000 d .C1_536
+00000394 d .C1_543
+00000017 d .C1_544
+00000398 d .C1_546
+00000028 d .C1_548
+0000039c d .C1_549
+00000049 d .C1_550
+000003a0 d .C1_551
+00000069 d .C1_552
+000003a4 d .C1_553
+00000088 d .C1_554
+000003a8 d .C1_555
+000000a9 d .C1_556
+000000c9 d .C1_557
+000003b0 d .C1_558
+000000e9 d .C1_559
+000003b4 d .C1_560
+00000108 d .C1_561
+000003b8 d .C1_562
+00000128 d .C1_563
+000003bc d .C1_564
+00000148 d .C1_565
+000003c0 d .C1_566
+00000169 d .C1_567
+000003c4 d .C1_568
+0000018b d .C1_569
+000003c8 d .C1_570
+000001ab d .C1_571
+000003cc d .C1_572
+000001cb d .C1_573
+000003d0 d .C1_574
+000001f2 d .C1_575
+000003d4 d .C1_576
+0000021b d .C1_577
+0000022e d .C1_578
+00000418 d .C1_579
+000003d8 d .C1_580
+00000236 d .C1_581
+000003dc d .C1_582
+00000245 d .C1_583
+000003e0 d .C1_584
+00000253 d .C1_585
+000003e4 d .C1_586
+00000260 d .C1_587
+000003e8 d .C1_588
+0000026f d .C1_589
+000003ec d .C1_590
+0000027d d .C1_591
+000003f0 d .C1_592
+0000028b d .C1_593
+000003f4 d .C1_594
+00000298 d .C1_595
+000003f8 d .C1_596
+000002a6 d .C1_597
+000003fc d .C1_598
+000002b4 d .C1_599
+00000400 d .C1_600
+000002c3 d .C1_602
+00000404 d .C1_603
+000002d3 d .C1_604
+00000408 d .C1_605
+000002e1 d .C1_606
+0000040c d .C1_607
+000002ef d .C1_608
+00000410 d .C1_609
+000002fe d .C1_610
+00000424 d .C1_613
+00000428 d .C1_615
+00000430 d .C1_618
+00000434 d .C1_627
+00000438 d .C1_628
+0000036a d .C1_629
+0000036f d .C1_635
+00000371 d .C1_636
+00000378 d .C1_637
+0000037c d .C1_638
+0000037e d .C1_639
+0000030d d .C1_640
+00000440 d .C1_641
+00000388 d .C1_643
+0000041c d .C1_991
+00000460 d .STATICS1
+00002b4e t __calchim_END
+         U __mth_i_acosx
+00000010 T calchim_
+000000c0 C callkeys_
+         U chemthermos_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0034bc00 C conc_
+         U ftn_str_copy
+         U init_chimie_b_
+         U perosat_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U photochemist_b_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U writediagfi_
+         U wstats_
+
+calldrag_noro.o:
+00000000 b .BSS1
+00000000 d .C1_310
+00000004 d .C1_356
+00000008 d .STATICS1
+00000285 t __calldrag_noro_END
+00000010 T calldrag_noro_
+         U drag_noro_
+         U pgf90_compiled
+         U sugwd_
+000189e4 C surfdat_
+
+callradite.o:
+00000000 b .BSS1
+00000188 d .C1_283
+00000184 d .C1_285
+00000154 d .C1_290
+0000015c d .C1_327
+00000144 d .C1_355
+0000017c d .C1_424
+000000eb d .C1_497
+00000148 d .C1_499
+00000000 d .C1_500
+00000174 d .C1_504
+0000014c d .C1_506
+00000028 d .C1_507
+00000150 d .C1_508
+00000180 d .C1_509
+00000050 d .C1_510
+00000158 d .C1_526
+00000160 d .C1_528
+0000006b d .C1_529
+00000164 d .C1_530
+00000088 d .C1_531
+00000168 d .C1_532
+0000016c d .C1_533
+000000ba d .C1_534
+00000170 d .C1_535
+000000e5 d .C1_536
+00000178 d .C1_537
+00000190 d .STATICS1
+00000f59 t __callradite_END
+         U abort_
+         U aeropacity_
+         U aeroptproperties_
+000000c0 C callkeys_
+00000010 T callradite_
+00000028 C comcstfi_
+06b3a000 C ksicom_
+         U lwmain_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U suaer_
+         U sulw_
+         U swmain_
+         U updatereffrad_
+000000e0 C yomlw_
+
+callsedim.o:
+00000000 b .BSS1
+000000b4 d .C1_283
+000000c8 d .C1_285
+000000b8 d .C1_318
+00000033 d .C1_442
+00000098 d .C1_444
+000000a8 d .C1_445
+00000000 d .C1_448
+000000ac d .C1_450
+0000009c d .C1_452
+00000013 d .C1_453
+000000a0 d .C1_454
+0000002b d .C1_455
+000000b0 d .C1_456
+000000a4 d .C1_457
+0000008b d .C1_458
+000000bc d .C1_461
+000000c0 d .C1_462
+000000c4 d .C1_463
+000000d0 d .STATICS1
+00000738 t __callsedim_END
+000000c0 C callkeys_
+00000010 T callsedim_
+00000028 C comcstfi_
+         U newsedim_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+callsedim2q.o:
+00000000 b .BSS1
+00000134 d .C1_283
+00000154 d .C1_285
+00000148 d .C1_287
+0000014c d .C1_290
+0000011c d .C1_316
+00000150 d .C1_382
+00000140 d .C1_405
+0000007e d .C1_415
+00000108 d .C1_417
+0000012c d .C1_418
+00000000 d .C1_421
+00000130 d .C1_423
+0000010c d .C1_425
+00000012 d .C1_426
+00000110 d .C1_427
+0000002a d .C1_428
+00000118 d .C1_429
+00000114 d .C1_430
+00000032 d .C1_431
+0000003c d .C1_438
+00000045 d .C1_439
+00000124 d .C1_440
+00000050 d .C1_441
+00000128 d .C1_442
+000000d8 d .C1_443
+00000138 d .C1_444
+0000013c d .C1_445
+00000144 d .C1_446
+00000120 d .C1_591
+00000158 d .STATICS1
+00001177 t __callsedim2q_END
+         U __mth_i_alogx
+         U __mth_i_expx
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+00000010 T callsedim2q_
+00000028 C comcstfi_
+         U ftn_strcmp
+         U newsedim_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U zerophys_
+
+cbrt.o:
+00000014 d .C1_287
+00000018 d .C1_288
+00000010 d .C1_298
+0000001c d .C1_305
+00000000 d .C1_307
+00000062 t __cbrt_END
+         U __mth_i_rpowrx
+00000010 T cbrt_
+         U pgf90_compiled
+
+ch.o:
+00000000 b .BSS1
+00000028 b .BSS3
+00004968 b .BSS4
+00004990 b .BSS5
+00000000 d .C2_292
+00000028 d .C3_291
+00000020 d .C3_449
+00000010 d .C3_718
+00000134 d .C4_283
+00000130 d .C4_285
+0000013c d .C4_306
+00000140 d .C4_317
+000000c4 d .C4_329
+00000118 d .C4_331
+00000138 d .C4_336
+0000011c d .C4_339
+00000120 d .C4_344
+00000124 d .C4_346
+00000128 d .C4_347
+0000012c d .C4_349
+00000478 d .C5_283
+00000474 d .C5_285
+0000041c d .C5_305
+00000470 d .C5_307
+00000030 d .STATICS3
+00000148 d .STATICS4
+00000480 d .STATICS5
+000004a0 d .STATICS6
+000000f1 t __ch_END
+0000172e t __dcadre_END
+00000181 t __fch_END
+         U __mth_i_dexpx
+         U __mth_i_dpowix
+         U __mth_i_dsinx
+00001ec1 t __uertst_END
+00002062 t __ugetio_END
+00002012 t __uspkd_END
+00000010 T ch_
+00000190 T dcadre_
+00000100 T fch_
+00000010 C integ_
+         U pgf90_compiled
+         U pgf90_template1v
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmt_write_a
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_intern_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_src_info
+         U pghpfio_fmt_read
+00001740 T uertst_
+00002020 T ugetio_
+00001ed0 T uspkd_
+
+chemthermos.o:
+00000000 b .BSS1
+00000230 d .C1_283
+0000022c d .C1_285
+00000238 d .C1_309
+00000224 d .C1_390
+00000204 d .C1_552
+00000228 d .C1_578
+0000016b d .C1_655
+000001f8 d .C1_657
+00000000 d .C1_658
+000001fc d .C1_664
+00000025 d .C1_665
+00000200 d .C1_666
+00000049 d .C1_667
+0000006c d .C1_668
+00000208 d .C1_669
+00000091 d .C1_670
+0000020c d .C1_671
+000000b5 d .C1_672
+00000210 d .C1_673
+000000d8 d .C1_674
+00000214 d .C1_675
+000000fc d .C1_676
+00000218 d .C1_677
+00000120 d .C1_678
+0000021c d .C1_679
+00000145 d .C1_680
+00000220 d .C1_681
+000001c8 d .C1_682
+00000240 d .C1_689
+00000234 d .C1_872
+0000023c d .C1_902
+00000248 d .STATICS1
+00000d90 t __chemthermos_END
+000000c0 C callkeys_
+00000010 T chemthermos_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0034bc00 C conc_
+         U flujo_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+         U jthermcalc_
+00067c50 C loss_
+         U paramfoto_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000294 C phdisef_
+00067c50 C prod_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00055e30 C uv_
+00004830 C vida_
+
+co2snow.o:
+00000000 b .BSS1
+000000cc d .C1_283
+000000c8 d .C1_285
+0000009c d .C1_405
+00000094 d .C1_406
+00000098 d .C1_407
+000000a0 d .C1_410
+000000a4 d .C1_411
+0000002a d .C1_412
+000000a8 d .C1_414
+000000bc d .C1_415
+00000000 d .C1_416
+000000c0 d .C1_420
+000000ac d .C1_422
+0000001a d .C1_423
+000000b0 d .C1_424
+000000b4 d .C1_425
+0000001e d .C1_426
+000000c4 d .C1_427
+000000b8 d .C1_428
+00000080 d .C1_429
+000000d0 d .STATICS1
+000004c5 t __co2snow_END
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+000000c0 C callkeys_
+00000010 T co2snow_
+00000028 C comcstfi_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000189e4 C surfdat_
+
+column.o:
+00000000 b .BSS1
+00000018 d .C1_287
+00000014 d .C1_288
+00000034 d .C1_290
+0000001c d .C1_320
+00000020 d .C1_322
+00000038 d .C1_326
+00000004 d .C1_328
+00000008 d .C1_330
+00000000 d .C1_332
+00000010 d .C1_481
+0000000c d .C1_482
+00000040 d .C1_483
+00000048 d .C1_485
+0000003c d .C1_486
+00000024 d .C1_575
+00000028 d .C1_577
+0000002c d .C1_579
+00000030 d .C1_581
+00000044 d .C1_591
+000005e5 t __column_END
+         U __mth_i_dcosx
+         U __mth_i_expx
+         U ch_
+00000010 T column_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+concentrations.o:
+00000000 b .BSS1
+000002d4 d .C1_283
+000002d0 d .C1_285
+000002e4 d .C1_287
+000002e8 d .C1_288
+00000298 d .C1_410
+000002cc d .C1_473
+000002c8 d .C1_507
+000001fe d .C1_533
+00000290 d .C1_535
+00000000 d .C1_536
+00000294 d .C1_542
+00000028 d .C1_543
+0000004f d .C1_544
+0000029c d .C1_545
+00000075 d .C1_546
+000002a0 d .C1_547
+0000009d d .C1_548
+000002a4 d .C1_549
+000000c4 d .C1_550
+000002a8 d .C1_551
+000000eb d .C1_552
+000002ac d .C1_553
+00000111 d .C1_554
+000002b0 d .C1_555
+00000138 d .C1_556
+000002b4 d .C1_557
+0000015f d .C1_558
+000002b8 d .C1_559
+00000187 d .C1_560
+000002bc d .C1_561
+000001b0 d .C1_562
+000002c0 d .C1_563
+000001d7 d .C1_564
+000002c4 d .C1_565
+0000025e d .C1_566
+000002f0 d .C1_584
+000002d8 d .C1_587
+000002dc d .C1_588
+000002e0 d .C1_589
+000002ec d .C1_590
+000002f8 d .STATICS1
+00001022 t __concentrations_END
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0034bc00 C conc_
+00000010 T concentrations_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+conduction.o:
+00000000 b .BSS1
+000000ac d .C1_283
+000000a8 d .C1_285
+000000b0 d .C1_287
+000000bc d .C1_288
+000000a4 d .C1_350
+000000b4 d .C1_354
+000000a0 d .C1_395
+000000b8 d .C1_422
+00000000 d .C1_425
+00000098 d .C1_427
+0000009c d .C1_428
+0000005c d .C1_429
+00000082 d .C1_432
+000000c0 d .STATICS1
+000006c5 t __conduction_END
+         U __mth_i_rpowrx
+00661074 C chimiedata_
+00000028 C comcstfi_
+0034bc00 C conc_
+00000010 T conduction_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000189e4 C surfdat_
+
+convadj.o:
+00000000 b .BSS1
+00000108 d .C1_283
+00000104 d .C1_285
+000000e0 d .C1_287
+000000e4 d .C1_288
+000000d4 d .C1_324
+000000cc d .C1_478
+0000006c d .C1_479
+000000c4 d .C1_481
+000000f8 d .C1_482
+000000c8 d .C1_486
+00000000 d .C1_487
+000000f0 d .C1_489
+00000011 d .C1_490
+000000fc d .C1_491
+000000d0 d .C1_492
+0000001b d .C1_493
+00000025 d .C1_494
+000000d8 d .C1_495
+000000dc d .C1_496
+000000e8 d .C1_502
+000000ec d .C1_503
+00000040 d .C1_504
+000000f4 d .C1_506
+00000100 d .C1_507
+00000030 d .C1_828
+00000110 d .STATICS1
+0000135f t __convadj_END
+000000c0 C callkeys_
+00000028 C comcstfi_
+00000010 T convadj_
+         U ftn_strcmp
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U scopy_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+cvmgp.o:
+00000000 d .C1_287
+00000041 t __cvmgp_END
+00000010 T cvmgp_
+         U pgf90_compiled
+
+cvmgt.o:
+0000003b t __cvmgt_END
+00000010 T cvmgt_
+         U pgf90_compiled
+
+datareadnc.o:
+00000000 b .BSS1
+0000024c d .C1_283
+0000026c d .C1_285
+0000020c d .C1_288
+00000234 d .C1_290
+00000224 d .C1_329
+00000228 d .C1_330
+00000240 d .C1_426
+00000248 d .C1_427
+00000260 d .C1_696
+00000264 d .C1_697
+0000025c d .C1_699
+00000254 d .C1_702
+00000250 d .C1_704
+00000186 d .C1_738
+00000210 d .C1_740
+00000000 d .C1_741
+0000001f d .C1_746
+00000214 d .C1_747
+0000002a d .C1_748
+00000218 d .C1_749
+00000244 d .C1_750
+0000004e d .C1_751
+0000021c d .C1_752
+00000067 d .C1_753
+00000078 d .C1_754
+00000220 d .C1_755
+00000079 d .C1_756
+000000a5 d .C1_757
+000000bf d .C1_758
+0000022c d .C1_759
+000000ef d .C1_760
+00000230 d .C1_761
+0000010c d .C1_762
+0000013f d .C1_764
+00000147 d .C1_765
+00000150 d .C1_767
+00000156 d .C1_768
+000001f9 d .C1_769
+00000238 d .C1_770
+0000015d d .C1_771
+0000017e d .C1_772
+00000181 d .C1_773
+00000182 d .C1_774
+0000023c d .C1_775
+000001df d .C1_776
+00000268 d .C1_779
+000001e5 d .C1_782
+000001e9 d .C1_783
+000001ed d .C1_784
+000001f1 d .C1_785
+000001f5 d .C1_786
+000001fc d .C1_789
+00000258 d .C1_906
+00000270 d .STATICS1
+0000103a t __datareadnc_END
+         U __mth_i_asinx
+         U abort_
+00000054 C comconst_
+000000d4 C comgeom_
+00000010 T datareadnc_
+         U dump2d_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+         U grid_noro1_
+         U initial0_
+         U interp_horiz_
+00000934 C lmdstdch_
+0000012c C lmdstdnu_
+         U lnblnk_
+         U multscal_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+def_var.o:
+00000104 d .C1_283
+00000100 d .C1_285
+000000dc d .C1_323
+000000f8 d .C1_324
+000000fc d .C1_325
+000000e0 d .C1_394
+000000e4 d .C1_395
+000000e8 d .C1_396
+000000ec d .C1_397
+000000f0 d .C1_398
+000000f4 d .C1_399
+00000084 d .C1_594
+00000000 d .C1_596
+000000dc d .C1_601
+00000022 d .C1_603
+00000027 d .C1_605
+00000053 d .C1_606
+00000058 d .C1_607
+00000b3f t __def_var_END
+00000010 T def_var_
+         U ftn_str_copy
+         U ftn_str_free
+         U ftn_str_malloc
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_adjustl
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+drag_noro.o:
+00000000 b .BSS1
+00000000 d .C1_290
+0000059b t __drag_noro_END
+         U __mth_i_alogx
+00000028 C comcstfi_
+00000010 T drag_noro_
+         U orodrag_
+         U pgf90_compiled
+
+dtridgl.o:
+00000000 b .BSS1
+00000000 d .C1_292
+00000158 t __dtridgl_END
+00000010 T dtridgl_
+         U pgf90_compiled
+
+dustdevil.o:
+00000000 b .BSS1
+000000e8 d .C1_283
+000000e4 d .C1_285
+00000100 d .C1_287
+000000fc d .C1_288
+000000ec d .C1_315
+00000057 d .C1_411
+000000bc d .C1_413
+000000d8 d .C1_414
+000000dc d .C1_415
+00000000 d .C1_416
+000000c0 d .C1_421
+0000000e d .C1_422
+00000019 d .C1_423
+000000c4 d .C1_424
+000000c8 d .C1_425
+00000025 d .C1_426
+000000cc d .C1_427
+00000037 d .C1_428
+000000d0 d .C1_429
+0000004f d .C1_430
+000000e0 d .C1_431
+000000d4 d .C1_432
+000000af d .C1_433
+000000f0 d .C1_435
+000000f4 d .C1_437
+000000f8 d .C1_440
+00000108 d .STATICS1
+0000095e t __dustdevil_END
+         U __mth_i_alogx
+         U __mth_i_rpowrx
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000010 T dustdevil_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000038 C planet_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+dustlift.o:
+00000000 b .BSS1
+000000d0 d .C1_283
+000000c4 d .C1_285
+000000d8 d .C1_287
+000000b4 d .C1_307
+00000046 d .C1_375
+000000a0 d .C1_377
+000000cc d .C1_378
+00000000 d .C1_379
+00000013 d .C1_380
+0000000a d .C1_381
+000000a4 d .C1_384
+000000a8 d .C1_385
+000000b8 d .C1_386
+00000016 d .C1_387
+000000bc d .C1_390
+000000c0 d .C1_391
+000000ac d .C1_393
+000000b0 d .C1_397
+0000002f d .C1_398
+000000c8 d .C1_399
+000000d4 d .C1_402
+000005a3 t __dustlift_END
+00000028 C comcstfi_
+00000010 T dustlift_
+         U pgf90_compiled
+         U pgf90io_close
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+eofdump.o:
+00000000 b .BSS1
+00000094 d .C1_283
+00000090 d .C1_285
+00000080 d .C1_315
+00000088 d .C1_318
+0000000e d .C1_333
+00000064 d .C1_335
+00000068 d .C1_336
+0000006c d .C1_337
+00000000 d .C1_338
+00000070 d .C1_346
+00000074 d .C1_351
+00000078 d .C1_352
+0000007c d .C1_353
+00000084 d .C1_354
+0000008c d .C1_355
+00000098 d .STATICS1
+00000940 t __eofdump_END
+00000004 C eofcom_
+00000010 T eofdump_
+         U ineofdump_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_template1v
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U pgf90io_unf_end
+         U pgf90io_unf_init
+         U pgf90io_unf_write
+         U pghpfio_unf_write
+
+euvheat.o:
+00000000 b .BSS1
+0000017c d .C1_283
+00000178 d .C1_285
+00000194 d .C1_312
+00000170 d .C1_392
+00000174 d .C1_618
+000000cf d .C1_659
+00000154 d .C1_661
+00000000 d .C1_664
+00000158 d .C1_668
+0000002d d .C1_669
+0000015c d .C1_670
+0000004e d .C1_671
+00000160 d .C1_672
+0000006d d .C1_673
+00000164 d .C1_674
+0000008d d .C1_675
+00000168 d .C1_676
+000000ad d .C1_677
+0000016c d .C1_678
+00000128 d .C1_679
+00000184 d .C1_681
+00000180 d .C1_682
+00000188 d .C1_683
+00000198 d .C1_687
+000001a0 d .C1_688
+0000018c d .C1_860
+00000190 d .C1_900
+0000019c d .C1_910
+000001a8 d .STATICS1
+00000b54 t __euvheat_END
+         U __mth_i_acosx
+         U __mth_i_alogx
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0034bc00 C conc_
+00000010 T euvheat_
+         U flujo_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+         U hrtherm_
+00067c50 C loss_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000294 C phdisef_
+00067c50 C prod_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00055e30 C uv_
+00004830 C vida_
+
+flujo.o:
+00000014 d .C1_288
+00000010 d .C1_290
+00000004 d .C1_439
+00000000 d .C1_440
+00000008 d .C1_442
+0000000c d .C1_443
+00000113 t __flujo_END
+         U __mth_i_sinx
+00000010 T flujo_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+flusv.o:
+00000000 b .BSS1
+02c9ac20 b .BSS2
+00000010 d .C1_287
+00000014 d .C1_288
+00000004 d .C1_290
+0000000c d .C1_344
+00000000 d .C1_387
+00000008 d .C1_388
+00000058 d .C2_288
+00000018 d .STATICS1
+000017ee t __flusv_END
+         U __mth_i_expx
+00001a05 t __sys3v_END
+00000010 T flusv_
+         U pgf90_compiled
+00001800 T sys3v_
+
+from36.o:
+00000000 b .BSS1
+000001ac d .C1_283
+000001a8 d .C1_285
+00000154 d .C1_318
+000000d8 d .C1_363
+00000144 d .C1_365
+000001a0 d .C1_366
+0000014c d .C1_369
+00000000 d .C1_370
+000001a4 d .C1_372
+00000148 d .C1_376
+0000015c d .C1_379
+00000029 d .C1_381
+00000150 d .C1_382
+00000046 d .C1_383
+00000158 d .C1_384
+0000005f d .C1_385
+00000160 d .C1_386
+00000190 d .C1_387
+00000164 d .C1_388
+00000168 d .C1_389
+0000008c d .C1_390
+0000016c d .C1_391
+00000099 d .C1_392
+00000170 d .C1_396
+0000009c d .C1_397
+00000174 d .C1_400
+000000b1 d .C1_401
+00000178 d .C1_402
+00000180 d .C1_407
+00000184 d .C1_408
+0000018c d .C1_409
+00000194 d .C1_412
+0000019c d .C1_414
+0000012b d .C1_415
+0000017c d .C1_529
+00000188 d .C1_544
+00000198 d .C1_552
+000001b0 d .STATICS1
+000011c6 t __from36_END
+         U __mth_i_ipowi
+00000010 T from36_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+gather.o:
+0000004c t __gather_END
+00000010 T gather_
+         U pgf90_compiled
+
+getch.o:
+00000080 d .C1_291
+00000008 d .C1_438
+00000000 d .C1_440
+00000018 d .C1_441
+00000010 d .C1_442
+00000020 d .C1_443
+00000030 d .C1_444
+00000028 d .C1_445
+00000040 d .C1_446
+00000038 d .C1_447
+00000048 d .C1_448
+00000058 d .C1_449
+00000050 d .C1_450
+00000060 d .C1_451
+000000a0 d .C1_452
+00000068 d .C1_453
+00000070 d .C1_454
+00000088 d .C1_455
+00000078 d .C1_456
+00000098 d .C1_457
+00000090 d .C1_458
+000000a8 d .C1_459
+000000b8 d .C1_460
+000000b0 d .C1_461
+000000d0 d .C1_462
+000000c8 d .C1_463
+000000c0 d .C1_469
+000001ff t __getch_END
+         U __mth_i_dexpx
+         U __mth_i_dpowdx
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00000010 T getch_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+growthrate.o:
+00000034 d .C1_288
+00000038 d .C1_292
+00000000 d .C1_324
+00000004 d .C1_325
+00000008 d .C1_326
+00000010 d .C1_327
+0000000c d .C1_328
+00000014 d .C1_329
+00000018 d .C1_330
+00000020 d .C1_331
+0000001c d .C1_332
+00000030 d .C1_333
+0000002c d .C1_334
+00000028 d .C1_335
+00000024 d .C1_336
+00000040 d .STATICS1
+00000257 t __growthrate_END
+         U __mth_i_expx
+00000010 T growthrate_
+         U pgf90_compiled
+
+gwprofil.o:
+00000000 b .BSS1
+00000000 d .C1_288
+00000008 d .C1_289
+0000000c d .C1_290
+00000004 d .C1_392
+00000010 d .STATICS1
+00000642 t __gwprofil_END
+00000010 T gwprofil_
+         U pgf90_compiled
+00000034 C yoegwd_
+
+gwstress.o:
+00000000 d .C1_287
+00000004 d .C1_379
+0000018e t __gwstress_END
+00000010 T gwstress_
+         U pgf90_compiled
+00000034 C yoegwd_
+
+hrtherm.o:
+00000000 b .BSS1
+00000004 d .C1_510
+00000001 d .C1_511
+00000000 d .C1_512
+00000008 d .C1_516
+00000010 d .STATICS1
+0000029a t __hrtherm_END
+000000c0 C callkeys_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00000010 T hrtherm_
+         U jthermcalc_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+ilsum.o:
+00000000 b .BSS1
+00000068 t __ilsum_END
+00000010 T ilsum_
+         U pgf90_compiled
+
+ineofdump.o:
+00000000 b .BSS1
+00000124 d .C1_283
+000000fc d .C1_285
+000000e4 d .C1_287
+0000010c d .C1_299
+000000ec d .C1_305
+00000110 d .C1_342
+00000118 d .C1_345
+00000120 d .C1_346
+000000d8 d .C1_356
+000000e0 d .C1_357
+00000010 d .C1_358
+00000068 d .C1_360
+000000dc d .C1_362
+0000003d d .C1_363
+00000049 d .C1_364
+00000108 d .C1_369
+000000f0 d .C1_370
+000000e8 d .C1_372
+00000052 d .C1_374
+000000f4 d .C1_375
+000000f8 d .C1_376
+00000100 d .C1_377
+00000104 d .C1_379
+00000114 d .C1_380
+0000011c d .C1_382
+000000c0 d .C1_383
+000000cc d .C1_384
+00000000 d .C1_451
+00000128 d .STATICS1
+000007b7 t __ineofdump_END
+         U __mth_i_nintx
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000a68 C comvert_
+00000004 C eofcom_
+00000010 T ineofdump_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_close
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+
+ini36.o:
+00000000 b .BSS1
+00000000 d .STATICS1
+000001b0 t __ini36_END
+00000024 C elbat1_
+00000a20 C elbat2_
+000222c0 C elbat3_
+         U ftn_str_copy
+00000010 T ini36_
+         U pgf90_compiled
+
+inichim_newstart.o:
+00000000 b .BSS1
+00000580 d .C1_283
+0000057c d .C1_285
+00000564 d .C1_287
+000004a4 d .C1_338
+00000578 d .C1_348
+000004d0 d .C1_360
+00000494 d .C1_362
+00000498 d .C1_364
+000004cc d .C1_375
+000001b4 d .C1_377
+000001b7 d .C1_378
+000001b9 d .C1_379
+000001ba d .C1_380
+000001bd d .C1_381
+000001bf d .C1_382
+000001c1 d .C1_383
+000001c2 d .C1_384
+000001c4 d .C1_385
+000001c6 d .C1_386
+000001c9 d .C1_387
+000001cd d .C1_388
+000001cf d .C1_389
+00000568 d .C1_525
+00000574 d .C1_533
+0000025c d .C1_552
+0000040f d .C1_553
+00000490 d .C1_555
+00000000 d .C1_557
+00000009 d .C1_558
+000004f0 d .C1_563
+00000570 d .C1_565
+0000000a d .C1_566
+00000037 d .C1_568
+00000056 d .C1_571
+0000049c d .C1_572
+00000072 d .C1_573
+000004a0 d .C1_575
+00000193 d .C1_576
+0000019c d .C1_577
+00000548 d .C1_578
+00000092 d .C1_579
+000001a0 d .C1_580
+000001a9 d .C1_581
+000001d1 d .C1_582
+000001d8 d .C1_583
+000001df d .C1_585
+000004a8 d .C1_586
+000000b5 d .C1_587
+000004ac d .C1_589
+000000e9 d .C1_590
+000004b0 d .C1_591
+00000114 d .C1_592
+000004b4 d .C1_593
+0000016a d .C1_594
+000004b8 d .C1_595
+00000171 d .C1_596
+000004bc d .C1_597
+00000177 d .C1_598
+000004c0 d .C1_600
+0000012d d .C1_601
+000004c4 d .C1_602
+00000151 d .C1_603
+000004c8 d .C1_604
+000004d4 d .C1_605
+000004d8 d .C1_606
+000004dc d .C1_607
+000001e4 d .C1_608
+00000201 d .C1_610
+000004e0 d .C1_611
+00000209 d .C1_612
+000004e4 d .C1_613
+00000256 d .C1_614
+000004e8 d .C1_615
+00000221 d .C1_616
+000004ec d .C1_617
+000004f4 d .C1_618
+00000558 d .C1_619
+0000025d d .C1_621
+000004f8 d .C1_623
+00000273 d .C1_624
+000004fc d .C1_625
+00000319 d .C1_626
+00000500 d .C1_627
+00000332 d .C1_628
+00000343 d .C1_629
+00000504 d .C1_630
+00000344 d .C1_631
+00000508 d .C1_632
+00000370 d .C1_633
+0000050c d .C1_634
+000002a2 d .C1_635
+00000510 d .C1_636
+000003bc d .C1_637
+00000514 d .C1_638
+000003d9 d .C1_639
+00000518 d .C1_640
+00000560 d .C1_641
+000002d4 d .C1_642
+0000051c d .C1_643
+000002ea d .C1_644
+00000520 d .C1_645
+00000524 d .C1_646
+00000528 d .C1_647
+0000052c d .C1_648
+00000530 d .C1_649
+0000038a d .C1_650
+00000534 d .C1_651
+00000538 d .C1_652
+0000053c d .C1_653
+00000540 d .C1_657
+00000544 d .C1_658
+0000054c d .C1_664
+00000550 d .C1_666
+00000554 d .C1_667
+0000055c d .C1_669
+0000040c d .C1_672
+0000056c d .C1_673
+00000471 d .C1_674
+00000483 d .C1_675
+00000588 d .STATICS1
+00003dc2 t __inichim_newstart_END
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+00000010 T inichim_newstart_
+         U inichim_readcallphys_
+         U intrplf_
+         U lnblnk_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90_trim
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_fmt_read
+00000014 C temps_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+inichim_readcallphys.o:
+00000000 b .BSS1
+000011d4 d .C1_283
+000011d0 d .C1_285
+00001154 d .C1_288
+00000fd8 d .C1_308
+000011c4 d .C1_310
+00001060 d .C1_311
+00000f94 d .C1_384
+00000ebe d .C1_504
+00000f84 d .C1_506
+00001150 d .C1_507
+00000000 d .C1_508
+00000015 d .C1_509
+0000000c d .C1_510
+00000f88 d .C1_513
+00000f8c d .C1_515
+00000f90 d .C1_518
+00000d65 d .C1_519
+000011cc d .C1_521
+00000f98 d .C1_522
+00000018 d .C1_523
+0000004a d .C1_524
+00000f9c d .C1_525
+00000fa0 d .C1_526
+00000059 d .C1_527
+0000007f d .C1_529
+00000fa4 d .C1_530
+00000085 d .C1_531
+00001100 d .C1_532
+00000fa8 d .C1_533
+0000008f d .C1_534
+00000fac d .C1_535
+0000009e d .C1_536
+000000d0 d .C1_538
+00000fb0 d .C1_539
+000000d7 d .C1_540
+00000fb4 d .C1_541
+000000e2 d .C1_542
+00000fb8 d .C1_543
+000000f2 d .C1_544
+00000120 d .C1_545
+0000012e d .C1_546
+00000fbc d .C1_547
+00000134 d .C1_548
+00000fc0 d .C1_549
+0000013e d .C1_550
+00000165 d .C1_551
+00000fc4 d .C1_552
+0000016b d .C1_553
+00000fc8 d .C1_554
+00000175 d .C1_555
+00000197 d .C1_556
+00000fcc d .C1_557
+000001a0 d .C1_558
+00000fd0 d .C1_559
+000001ad d .C1_560
+000001d6 d .C1_561
+000001e7 d .C1_562
+00000fd4 d .C1_563
+000001f2 d .C1_564
+00000201 d .C1_565
+0000020f d .C1_566
+00000fdc d .C1_567
+00000216 d .C1_568
+000011c8 d .C1_569
+00000fe0 d .C1_570
+00001114 d .C1_571
+00000221 d .C1_572
+00000fe4 d .C1_573
+0000023c d .C1_574
+0000025e d .C1_575
+00000283 d .C1_576
+000002aa d .C1_577
+00000fe8 d .C1_578
+000002b0 d .C1_579
+00000fec d .C1_580
+000002ba d .C1_581
+00000ff0 d .C1_582
+000002ec d .C1_583
+00000ff4 d .C1_584
+000002f6 d .C1_585
+00000ff8 d .C1_586
+00000304 d .C1_587
+0000031d d .C1_588
+00000ffc d .C1_589
+00000324 d .C1_590
+00001000 d .C1_591
+0000032f d .C1_592
+00000379 d .C1_593
+0000034c d .C1_594
+00001004 d .C1_595
+00000354 d .C1_596
+00001008 d .C1_597
+00000360 d .C1_598
+00000394 d .C1_599
+0000100c d .C1_600
+0000039e d .C1_601
+00001010 d .C1_602
+000003ac d .C1_603
+000003cf d .C1_604
+00001014 d .C1_605
+000003d7 d .C1_606
+00001018 d .C1_607
+000003e3 d .C1_608
+000003ff d .C1_609
+0000101c d .C1_610
+00000406 d .C1_611
+00001020 d .C1_612
+00000411 d .C1_613
+00000428 d .C1_614
+00001024 d .C1_615
+00000430 d .C1_616
+00001028 d .C1_617
+0000043c d .C1_618
+00000461 d .C1_619
+0000102c d .C1_620
+00000469 d .C1_621
+00001030 d .C1_622
+00000475 d .C1_623
+000004a1 d .C1_624
+000004a9 d .C1_625
+00001034 d .C1_626
+000004b1 d .C1_627
+00001038 d .C1_628
+000004bd d .C1_629
+000004e2 d .C1_630
+000004f4 d .C1_631
+0000103c d .C1_632
+000004fa d .C1_633
+00001040 d .C1_634
+00000504 d .C1_635
+00000530 d .C1_636
+00000546 d .C1_637
+00001044 d .C1_638
+0000054d d .C1_639
+00001048 d .C1_640
+00000558 d .C1_641
+00000589 d .C1_642
+0000104c d .C1_643
+00000591 d .C1_644
+00001050 d .C1_645
+0000059d d .C1_646
+000005d0 d .C1_647
+00001054 d .C1_648
+000005d7 d .C1_649
+00001058 d .C1_650
+000005e2 d .C1_651
+00000612 d .C1_652
+0000105c d .C1_653
+00000618 d .C1_654
+00000622 d .C1_655
+00001064 d .C1_657
+0000064c d .C1_658
+00000678 d .C1_659
+00000684 d .C1_660
+00001068 d .C1_661
+0000068b d .C1_662
+0000106c d .C1_663
+00000696 d .C1_664
+00001070 d .C1_665
+000006c2 d .C1_666
+000006e4 d .C1_667
+00001074 d .C1_668
+000006eb d .C1_669
+00001078 d .C1_670
+000006f6 d .C1_671
+0000107c d .C1_672
+00000721 d .C1_673
+0000073e d .C1_674
+00001080 d .C1_675
+00000748 d .C1_676
+00001084 d .C1_677
+00000756 d .C1_678
+00001088 d .C1_679
+00000783 d .C1_680
+000007a4 d .C1_681
+0000108c d .C1_682
+000007ae d .C1_683
+00001090 d .C1_684
+000007bc d .C1_685
+00001094 d .C1_686
+000007ea d .C1_687
+00000808 d .C1_688
+00001098 d .C1_689
+00000815 d .C1_690
+0000109c d .C1_691
+00000826 d .C1_692
+00000838 d .C1_693
+000010a0 d .C1_694
+0000085e d .C1_695
+00000889 d .C1_696
+00000894 d .C1_697
+000010a4 d .C1_698
+0000089c d .C1_699
+000010a8 d .C1_700
+000008a8 d .C1_701
+000008bd d .C1_702
+000010ac d .C1_703
+000008c2 d .C1_704
+000010b0 d .C1_705
+000008cb d .C1_706
+000008ea d .C1_707
+000010b4 d .C1_708
+00000900 d .C1_709
+0000092d d .C1_710
+0000094b d .C1_711
+000010b8 d .C1_712
+0000094f d .C1_713
+000010bc d .C1_714
+00000957 d .C1_715
+000010c0 d .C1_716
+00000984 d .C1_717
+000009ac d .C1_718
+000010c4 d .C1_719
+000009b5 d .C1_720
+000010c8 d .C1_721
+000009c2 d .C1_722
+000009d5 d .C1_723
+000010cc d .C1_724
+000009e0 d .C1_725
+000010d0 d .C1_726
+000009ef d .C1_727
+00000a0d d .C1_728
+00000a24 d .C1_729
+000010d4 d .C1_730
+00000a30 d .C1_731
+000010d8 d .C1_732
+00000a40 d .C1_733
+00000b20 d .C1_734
+00000a59 d .C1_735
+000010dc d .C1_736
+00000a64 d .C1_737
+000010e0 d .C1_738
+00000a73 d .C1_739
+00000a85 d .C1_740
+000010e4 d .C1_741
+00000a8c d .C1_742
+000010e8 d .C1_743
+00000a97 d .C1_744
+00000ab1 d .C1_745
+000010ec d .C1_746
+00000abb d .C1_747
+000010f0 d .C1_748
+00000ac9 d .C1_749
+00000ae3 d .C1_750
+000010f4 d .C1_751
+00000aee d .C1_752
+000010f8 d .C1_753
+00000afd d .C1_754
+00000b3d d .C1_755
+000010fc d .C1_756
+00000b47 d .C1_757
+00001104 d .C1_758
+00000b55 d .C1_759
+00000b75 d .C1_760
+00001108 d .C1_761
+00000b8a d .C1_762
+0000110c d .C1_763
+00000bb2 d .C1_764
+00001110 d .C1_765
+00000bbe d .C1_766
+00001118 d .C1_767
+00000bce d .C1_768
+0000111c d .C1_769
+00000bfe d .C1_770
+00001120 d .C1_771
+00000c2d d .C1_772
+00001124 d .C1_773
+00000c58 d .C1_774
+00001128 d .C1_775
+00000c86 d .C1_776
+0000112c d .C1_777
+00000cb5 d .C1_778
+00001130 d .C1_779
+00000ce3 d .C1_780
+00001134 d .C1_781
+00000d11 d .C1_782
+00001138 d .C1_783
+0000113c d .C1_784
+00001140 d .C1_785
+00001144 d .C1_786
+00001148 d .C1_787
+00000d91 d .C1_788
+0000114c d .C1_789
+00001158 d .C1_790
+00000dbc d .C1_791
+0000115c d .C1_792
+00000dfe d .C1_793
+00001160 d .C1_794
+00000e4f d .C1_795
+00001164 d .C1_796
+00000e65 d .C1_797
+00001168 d .C1_798
+0000116c d .C1_799
+00000e3d d .C1_800
+00001170 d .C1_801
+00001174 d .C1_802
+00001178 d .C1_803
+0000117c d .C1_804
+00000dda d .C1_805
+00001180 d .C1_806
+00000ea7 d .C1_807
+00001184 d .C1_808
+00001188 d .C1_809
+00000e17 d .C1_810
+0000118c d .C1_811
+00001190 d .C1_812
+00000e78 d .C1_813
+00001194 d .C1_814
+00001198 d .C1_816
+0000119c d .C1_817
+000011a0 d .C1_818
+000011a4 d .C1_819
+000011a8 d .C1_820
+000011ac d .C1_821
+00000e82 d .C1_822
+00000e91 d .C1_823
+000011b0 d .C1_824
+000011b4 d .C1_825
+000011b8 d .C1_826
+000011bc d .C1_827
+000011c0 d .C1_828
+00000f24 d .C1_829
+00000f2c d .C1_830
+00000f56 d .C1_831
+00005184 t __inichim_readcallphys_END
+         U __mth_i_asinx
+000000c0 C callkeys_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000010 T inichim_readcallphys_
+         U ioipsl_errioipsl_
+00000014 C ioipsl_errioipsl_12_
+         U ioipsl_getincom_
+0000002c C ioipsl_getincom_12_
+00000006 C ioipsl_getincom_13_
+000002b4 C ioipsl_getincom_4_
+00002710 C ioipsl_getincom_5_
+         U ioipsl_getincom_getinis_
+         U ioipsl_getincom_getinls_
+         U ioipsl_getincom_getinrs_
+         U ioipsl_stringop_
+00000078 C ioipsl_stringop_8_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_close
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+00000038 C planet_
+00007090 C saison_
+000189e4 C surfdat_
+
+iniorbit.o:
+00000000 b .BSS1
+0000012c d .C1_283
+00000128 d .C1_285
+00000108 d .C1_287
+00000114 d .C1_288
+00000110 d .C1_290
+00000066 d .C1_333
+000000e8 d .C1_335
+0000011c d .C1_336
+00000000 d .C1_339
+00000120 d .C1_341
+00000124 d .C1_342
+000000ec d .C1_344
+00000012 d .C1_345
+000000f0 d .C1_346
+00000024 d .C1_347
+000000f4 d .C1_348
+000000f8 d .C1_349
+0000003a d .C1_350
+000000fc d .C1_351
+00000041 d .C1_352
+00000100 d .C1_353
+00000048 d .C1_354
+00000104 d .C1_356
+0000010c d .C1_358
+00000060 d .C1_359
+00000118 d .C1_360
+000000bd d .C1_361
+00000050 d .C1_429
+00000890 t __iniorbit_END
+         U __mth_i_asinx
+         U __mth_i_atanx
+         U __mth_i_nintx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+         U __mth_i_tanx
+00000028 C comcstfi_
+00000010 T iniorbit_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000038 C planet_
+
+inistats.o:
+00000000 b .BSS1
+00000248 d .C1_283
+00000264 d .C1_285
+00000230 d .C1_287
+00000228 d .C1_290
+00000240 d .C1_300
+00000260 d .C1_319
+00000250 d .C1_320
+00000244 d .C1_321
+00000258 d .C1_322
+00000218 d .C1_415
+0000025c d .C1_418
+00000238 d .C1_443
+0000023c d .C1_444
+00000210 d .C1_512
+00000214 d .C1_513
+0000021c d .C1_514
+00000224 d .C1_515
+00000234 d .C1_516
+000000e8 d .C1_720
+000001fc d .C1_722
+00000200 d .C1_726
+00000000 d .C1_727
+00000204 d .C1_729
+00000208 d .C1_730
+00000023 d .C1_731
+0000024c d .C1_732
+00000220 d .C1_733
+00000029 d .C1_734
+0000002f d .C1_735
+0000020c d .C1_736
+00000050 d .C1_737
+00000078 d .C1_739
+000000a7 d .C1_740
+000000ae d .C1_741
+000000b6 d .C1_742
+000000c3 d .C1_743
+000000ce d .C1_744
+0000022c d .C1_745
+000000e0 d .C1_746
+0000013f d .C1_747
+00000165 d .C1_748
+0000017a d .C1_749
+000001a6 d .C1_750
+0000013f d .C1_751
+00000144 d .C1_752
+00000148 d .C1_754
+0000016d d .C1_755
+00000254 d .C1_756
+00000183 d .C1_757
+00000191 d .C1_758
+0000019d d .C1_759
+000001ae d .C1_760
+000001b3 d .C1_761
+000001b5 d .C1_762
+000001bd d .C1_763
+000001bf d .C1_764
+000001c2 d .C1_765
+000001fa d .C1_766
+000001de d .C1_767
+000001e1 d .C1_768
+00000040 d .C1_923
+00001027 t __inistats_END
+         U __mth_i_alogx
+         U __mth_i_nintx
+00000054 C comconst_
+000000d4 C comgeom_
+00000a68 C comvert_
+         U def_var_
+00000010 T inistats_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000068 C sttcom_
+
+init_chimie_B.o:
+00000000 b .BSS1
+0000023c d .C1_283
+00000234 d .C1_285
+00000218 d .C1_309
+00000228 d .C1_364
+0000018a d .C1_365
+000001ec d .C1_367
+0000000f d .C1_368
+00000018 d .C1_369
+00000000 d .C1_370
+000001f0 d .C1_374
+0000022c d .C1_375
+0000001b d .C1_376
+00000230 d .C1_379
+000001f4 d .C1_381
+00000043 d .C1_382
+000001f8 d .C1_383
+00000062 d .C1_384
+00000073 d .C1_385
+000001fc d .C1_386
+00000074 d .C1_387
+00000200 d .C1_388
+000000a0 d .C1_389
+00000204 d .C1_390
+000000ba d .C1_391
+00000208 d .C1_392
+000000ee d .C1_393
+0000020c d .C1_394
+0000010b d .C1_395
+00000210 d .C1_397
+0000013e d .C1_398
+00000214 d .C1_400
+0000021c d .C1_404
+00000220 d .C1_406
+00000224 d .C1_408
+00000163 d .C1_409
+00000238 d .C1_410
+00000240 d .STATICS1
+00000cc3 t __init_chimie_b_END
+00661074 C chimiedata_
+         U ftn_str_copy
+00000010 T init_chimie_b_
+         U lnblnk_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90io_close
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_ldr
+
+initracer.o:
+00000000 b .BSS1
+0000049c d .C1_283
+0000048c d .C1_285
+00000428 d .C1_287
+00000488 d .C1_426
+00000490 d .C1_427
+0000044c d .C1_454
+000003e8 d .C1_456
+00000190 d .C1_459
+00000193 d .C1_460
+00000195 d .C1_461
+00000196 d .C1_462
+00000199 d .C1_463
+0000019b d .C1_464
+0000019d d .C1_465
+0000019e d .C1_466
+000001a0 d .C1_467
+000001a2 d .C1_468
+000001a5 d .C1_469
+000001a9 d .C1_470
+000001ab d .C1_471
+0000022a d .C1_491
+000003b4 d .C1_492
+00000350 d .C1_493
+000003a8 d .C1_495
+00000000 d .C1_496
+00000009 d .C1_497
+00000484 d .C1_499
+00000454 d .C1_503
+000003ac d .C1_505
+00000498 d .C1_506
+0000000a d .C1_507
+00000037 d .C1_509
+000003b0 d .C1_512
+0000004f d .C1_513
+0000006b d .C1_514
+000003b8 d .C1_516
+00000173 d .C1_517
+00000290 d .C1_518
+000003bc d .C1_520
+0000009b d .C1_521
+0000017c d .C1_522
+00000185 d .C1_523
+000001ad d .C1_524
+000001b4 d .C1_526
+000001bb d .C1_528
+000003c0 d .C1_529
+000000be d .C1_530
+000003c4 d .C1_532
+00000104 d .C1_533
+000003c8 d .C1_534
+000000eb d .C1_535
+000003cc d .C1_536
+00000141 d .C1_537
+000003d0 d .C1_538
+00000148 d .C1_539
+000003d4 d .C1_540
+00000151 d .C1_541
+000003d8 d .C1_542
+00000157 d .C1_543
+000003dc d .C1_544
+000003e0 d .C1_545
+00000128 d .C1_546
+000003e4 d .C1_547
+000003ec d .C1_548
+000003f0 d .C1_549
+000003f4 d .C1_550
+000003f8 d .C1_552
+000003fc d .C1_553
+000001c0 d .C1_555
+000001d6 d .C1_556
+00000400 d .C1_557
+000001de d .C1_558
+00000404 d .C1_559
+00000224 d .C1_560
+00000408 d .C1_561
+000001f6 d .C1_562
+0000040c d .C1_563
+00000410 d .C1_565
+00000414 d .C1_566
+00000418 d .C1_567
+0000022b d .C1_568
+0000041c d .C1_569
+000002ab d .C1_570
+0000024d d .C1_571
+0000045c d .C1_572
+00000420 d .C1_573
+0000043c d .C1_574
+00000424 d .C1_575
+00000440 d .C1_576
+0000042c d .C1_577
+00000444 d .C1_578
+00000430 d .C1_579
+00000434 d .C1_580
+00000438 d .C1_581
+00000257 d .C1_582
+00000261 d .C1_583
+00000448 d .C1_586
+00000450 d .C1_588
+00000294 d .C1_589
+00000458 d .C1_590
+00000460 d .C1_591
+00000464 d .C1_592
+000002b2 d .C1_593
+00000468 d .C1_594
+000002e2 d .C1_595
+0000046c d .C1_597
+000002ef d .C1_598
+00000470 d .C1_599
+000002fd d .C1_600
+00000474 d .C1_601
+00000307 d .C1_602
+00000478 d .C1_603
+00000319 d .C1_604
+0000047c d .C1_605
+00000337 d .C1_606
+00000480 d .C1_607
+00000348 d .C1_608
+00000494 d .C1_609
+000004a0 d .STATICS1
+00002e37 t __initracer_END
+         U __mth_i_expx
+00000018 C advtr_
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+00000010 T initracer_
+00003840 C permcap_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U zerophys_
+
+iniwrite.o:
+00000000 b .BSS1
+000002e0 d .C1_283
+000002dc d .C1_285
+000002c0 d .C1_302
+000002b8 d .C1_321
+000002a8 d .C1_323
+000002b4 d .C1_326
+000002d0 d .C1_461
+000002b0 d .C1_464
+0000029c d .C1_465
+00000298 d .C1_467
+00000294 d .C1_468
+000002d4 d .C1_469
+000002ac d .C1_539
+00000288 d .C1_766
+0000028c d .C1_781
+000002a4 d .C1_783
+00000290 d .C1_784
+00000000 d .C1_788
+0000003a d .C1_789
+00000054 d .C1_790
+00000077 d .C1_791
+000000b0 d .C1_792
+00000005 d .C1_793
+0000009a d .C1_794
+0000000f d .C1_795
+00000020 d .C1_796
+000001be d .C1_797
+00000028 d .C1_798
+0000003f d .C1_799
+000002a0 d .C1_800
+0000016b d .C1_801
+0000005c d .C1_802
+0000014e d .C1_803
+00000069 d .C1_804
+00000080 d .C1_805
+0000008e d .C1_806
+000000a2 d .C1_807
+000000ac d .C1_808
+00000171 d .C1_809
+000000ae d .C1_810
+000000b5 d .C1_811
+000000c9 d .C1_813
+000000cc d .C1_814
+00000125 d .C1_815
+000000e9 d .C1_816
+000002c4 d .C1_817
+000000ec d .C1_818
+00000144 d .C1_819
+00000105 d .C1_820
+00000107 d .C1_821
+00000127 d .C1_822
+000002d8 d .C1_823
+00000129 d .C1_824
+00000145 d .C1_825
+00000157 d .C1_826
+00000170 d .C1_827
+00000179 d .C1_828
+0000017d d .C1_829
+00000181 d .C1_830
+0000017f d .C1_831
+000001a9 d .C1_832
+000001ad d .C1_833
+000001b6 d .C1_834
+000001c3 d .C1_835
+00000219 d .C1_836
+000002bc d .C1_838
+000001de d .C1_839
+000002c8 d .C1_844
+000001fb d .C1_845
+000002cc d .C1_846
+00000270 d .C1_847
+00001794 t __iniwrite_END
+00000028 C comcstfi_
+000000d4 C comgeom_
+00000050 C comsoil1_
+00023284 C comsoil2_
+00000a68 C comvert_
+         U def_var_
+0000011c C ener_
+00000010 T iniwrite_
+0000003c C logic_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000038 C serre_
+00000014 C temps_
+00000078 C titre_
+
+iniwritesoil.o:
+00000000 b .BSS1
+00000458 d .C1_283
+00000454 d .C1_285
+000003fc d .C1_308
+00000430 d .C1_325
+00000440 d .C1_326
+00000418 d .C1_327
+0000043c d .C1_328
+0000044c d .C1_422
+00000450 d .C1_423
+000003f4 d .C1_491
+000003f8 d .C1_492
+00000400 d .C1_493
+00000404 d .C1_494
+000000da d .C1_701
+0000035c d .C1_702
+00000000 d .C1_704
+00000135 d .C1_709
+00000039 d .C1_710
+000001c6 d .C1_711
+00000071 d .C1_712
+0000021f d .C1_713
+000000a6 d .C1_714
+00000408 d .C1_715
+000000e3 d .C1_716
+0000011b d .C1_717
+0000033f d .C1_718
+00000129 d .C1_720
+00000357 d .C1_721
+0000041c d .C1_722
+0000040c d .C1_723
+0000018f d .C1_724
+00000410 d .C1_725
+0000013d d .C1_726
+00000174 d .C1_727
+00000182 d .C1_728
+00000420 d .C1_729
+00000424 d .C1_730
+00000223 d .C1_731
+000001cb d .C1_732
+000001df d .C1_733
+000001e0 d .C1_734
+000001e4 d .C1_735
+00000428 d .C1_736
+000001ec d .C1_737
+0000042c d .C1_738
+00000257 d .C1_739
+0000025b d .C1_740
+00000279 d .C1_741
+00000434 d .C1_742
+0000027d d .C1_743
+000002b0 d .C1_744
+000002b9 d .C1_745
+00000438 d .C1_746
+000002bb d .C1_747
+000002ed d .C1_748
+00000444 d .C1_749
+000002f7 d .C1_750
+00000330 d .C1_751
+00000348 d .C1_752
+00000448 d .C1_753
+000003b9 d .C1_754
+00000414 d .C1_777
+0000177c t __iniwritesoil_END
+00000028 C comcstfi_
+000000d4 C comgeom_
+00000050 C comsoil1_
+00023284 C comsoil2_
+         U ftn_str_cpy1
+00000010 T iniwritesoil_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+interp_line.o:
+00000000 b .BSS1
+00000000 d .C1_352
+00000199 t __interp_line_END
+00000010 T interp_line_
+         U pgf90_compiled
+
+interpfast.o:
+00000000 b .BSS1
+00000010 d .C1_288
+00000000 d .C1_362
+00000122 t __interpfast_END
+00000010 T interpfast_
+         U pgf90_compiled
+
+intrplf.o:
+00000000 b .BSS1
+00000004 d .C1_287
+00000000 d .C1_304
+0000017c t __intrplf_END
+00000010 T intrplf_
+         U pgf90_compiled
+
+inv.o:
+00000000 b .BSS1
+000000a4 d .C1_283
+000000a0 d .C1_285
+000000ac d .C1_287
+000000a8 d .C1_288
+00000090 d .C1_298
+00000020 d .C1_314
+0000008c d .C1_316
+00000098 d .C1_317
+00000000 d .C1_318
+0000009c d .C1_322
+00000094 d .C1_326
+00000075 d .C1_327
+00000088 d .C1_337
+00000010 d .C1_462
+00000920 t __inv_END
+00000010 T inv_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+ioipsl_errioipsl.o:
+00000000 A ..Dm_ioipsl_errioipsl
+000000d4 d .C3_283
+000000d0 d .C3_285
+0000001f d .C3_313
+000000c4 d .C3_315
+00000014 d .C3_316
+000000cc d .C3_318
+000000c8 d .C3_323
+0000007e d .C3_324
+0000008e d .C3_325
+00000204 d .C6_283
+00000200 d .C6_285
+000001f8 d .C6_297
+00000144 d .C6_314
+000001e4 d .C6_316
+00000132 d .C6_317
+000001fc d .C6_319
+000001e8 d .C6_323
+0000013b d .C6_324
+000001ec d .C6_326
+000001a3 d .C6_327
+000001f0 d .C6_328
+000001f4 d .C6_329
+000001ae d .C6_330
+000000d8 d .STATICS3
+00000208 d .STATICS6
+000009ff t __ioipsl_errioipsl_histerr_END
+00000a5c t __ioipsl_errioipsl_ipsldbg_END
+000004e8 t __ioipsl_errioipsl_ipslerr_END
+00000550 t __ioipsl_errioipsl_ipslerr_act_END
+000005ac t __ioipsl_errioipsl_ipslerr_inq_END
+0000005c t __ioipsl_errioipsl_ipslnlf_END
+00000000 T ioipsl_errioipsl_
+00000000 D ioipsl_errioipsl_12_
+000005b0 T ioipsl_errioipsl_histerr_
+00000a10 T ioipsl_errioipsl_ipsldbg_
+00000060 T ioipsl_errioipsl_ipslerr_
+000004f0 T ioipsl_errioipsl_ipslerr_act_
+00000560 T ioipsl_errioipsl_ipslerr_inq_
+00000010 T ioipsl_errioipsl_ipslnlf_
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_present
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_src_info
+
+ioipsl_getincom.o:
+00000000 A ..Dm_ioipsl_getincom
+000002a8 b .BSS10
+00000318 b .BSS11
+00000328 b .BSS12
+00000390 b .BSS13
+00000400 b .BSS14
+000004d8 b .BSS15
+000004e8 b .BSS16
+00000500 b .BSS17
+00000508 b .BSS18
+000006b8 b .BSS19
+00000000 b .BSS2
+00000800 b .BSS20
+00000808 b .BSS21
+00000870 b .BSS22
+00000888 b .BSS23
+000008a0 b .BSS24
+000008d0 b .BSS25
+00000a00 b .BSS27
+00000010 b .BSS3
+00000078 b .BSS4
+000000e8 b .BSS5
+000000f8 b .BSS6
+00000160 b .BSS7
+000001d0 b .BSS8
+00000240 b .BSS9
+000000f4 d .C10_283
+000000e8 d .C10_285
+000000f0 d .C10_307
+000000ec d .C10_450
+00000104 d .C11_283
+00000100 d .C11_285
+00000118 d .C12_283
+0000010c d .C12_285
+00000114 d .C12_335
+00000110 d .C12_429
+00000134 d .C13_283
+00000128 d .C13_285
+00000130 d .C13_335
+0000012c d .C13_440
+00000310 d .C14_283
+00000308 d .C14_285
+0000030c d .C14_338
+000002cc d .C14_342
+00000314 d .C14_343
+000002b8 d .C14_344
+0000028c d .C14_436
+00000304 d .C14_437
+00000293 d .C14_438
+000002a1 d .C14_439
+000002b5 d .C14_440
+00000214 d .C14_443
+000002bc d .C14_445
+000002e8 d .C14_450
+00000140 d .C14_452
+00000142 d .C14_454
+00000145 d .C14_455
+000002c0 d .C14_457
+0000014c d .C14_458
+000002c4 d .C14_459
+000002c8 d .C14_464
+000002f0 d .C14_467
+0000015c d .C14_469
+0000015b d .C14_470
+00000160 d .C14_471
+0000015f d .C14_472
+00000163 d .C14_474
+0000016a d .C14_475
+000002fc d .C14_476
+00000174 d .C14_477
+00000179 d .C14_478
+00000181 d .C14_479
+0000019c d .C14_480
+000001bf d .C14_481
+000002d0 d .C14_484
+000001d7 d .C14_485
+000002d4 d .C14_489
+000001f3 d .C14_490
+00000211 d .C14_491
+000002e0 d .C14_493
+000002d8 d .C14_494
+0000020b d .C14_495
+000002dc d .C14_496
+000002e4 d .C14_497
+00000213 d .C14_498
+000002ec d .C14_500
+000002f4 d .C14_501
+000002f8 d .C14_502
+00000300 d .C14_504
+00000272 d .C14_505
+0000039c d .C15_285
+000003a4 d .C15_337
+00000380 d .C15_412
+000003a0 d .C15_413
+00000318 d .C15_414
+00000326 d .C15_415
+00000399 d .C15_416
+0000033a d .C15_417
+00000356 d .C15_418
+0000035b d .C15_419
+0000035c d .C15_420
+00000374 d .C15_421
+00000387 d .C15_423
+000003d4 d .C16_338
+000003a8 d .C16_420
+000003af d .C16_421
+000003bd d .C16_422
+000003d1 d .C16_423
+000003d8 d .C16_441
+000003dc d .C16_560
+000003f8 d .C17_283
+000003e8 d .C17_285
+000003ec d .C17_332
+000003f0 d .C17_333
+000003f4 d .C17_334
+000003e0 d .C17_383
+00000524 d .C18_283
+00000514 d .C18_285
+00000528 d .C18_338
+00000508 d .C18_339
+00000475 d .C18_401
+00000518 d .C18_408
+000004f8 d .C18_410
+00000520 d .C18_411
+00000404 d .C18_412
+000004e7 d .C18_414
+000004d3 d .C18_415
+000004f4 d .C18_416
+00000407 d .C18_419
+00000473 d .C18_420
+000004fc d .C18_421
+00000408 d .C18_422
+00000510 d .C18_426
+00000500 d .C18_428
+00000504 d .C18_432
+00000417 d .C18_433
+0000043f d .C18_438
+0000045f d .C18_439
+0000050c d .C18_440
+0000051c d .C18_444
+000006b4 d .C19_283
+000006b0 d .C19_285
+00000690 d .C19_337
+0000069c d .C19_338
+0000062a d .C19_397
+00000545 d .C19_399
+000005eb d .C19_401
+000006ac d .C19_402
+0000052c d .C19_403
+0000054f d .C19_404
+000005d6 d .C19_405
+000005d7 d .C19_406
+00000689 d .C19_407
+00000550 d .C19_408
+0000057c d .C19_409
+000005d8 d .C19_410
+0000059d d .C19_411
+000005b7 d .C19_412
+0000062b d .C19_413
+00000694 d .C19_415
+000005c7 d .C19_416
+000006a8 d .C19_418
+00000698 d .C19_423
+0000068c d .C19_428
+000005f8 d .C19_431
+000006a0 d .C19_432
+000006a4 d .C19_434
+000007f0 d .C20_283
+000007ec d .C20_285
+000007e4 d .C20_331
+00000735 d .C20_380
+000007c8 d .C20_382
+000006b8 d .C20_383
+000007e8 d .C20_387
+000007cc d .C20_388
+000007d0 d .C20_390
+000006c0 d .C20_391
+000007d4 d .C20_392
+000006e9 d .C20_393
+000007d8 d .C20_394
+00000721 d .C20_395
+00000731 d .C20_396
+000007dc d .C20_397
+000007e0 d .C20_398
+00000793 d .C20_399
+000007c5 d .C20_400
+00000894 d .C21_283
+00000890 d .C21_285
+00000888 d .C21_330
+00000898 d .C21_335
+00000859 d .C21_383
+000007f4 d .C21_384
+000007f8 d .C21_386
+00000884 d .C21_388
+00000856 d .C21_389
+0000088c d .C21_393
+0000085a d .C21_398
+00000868 d .C21_399
+00000880 d .C21_400
+00000960 d .C22_283
+0000095c d .C22_285
+0000094c d .C22_333
+0000096c d .C22_336
+000008b8 d .C22_389
+00000948 d .C22_391
+00000958 d .C22_395
+0000091e d .C22_397
+0000092d d .C22_398
+00000916 d .C22_399
+00000945 d .C22_400
+00000950 d .C22_402
+0000089c d .C22_404
+00000954 d .C22_405
+00000964 d .C22_422
+00000968 d .C22_423
+00000b28 d .C23_283
+00000b24 d .C23_285
+00000b00 d .C23_308
+00000b0c d .C23_333
+00000b2c d .C23_337
+00000b18 d .C23_338
+00000a3e d .C23_412
+00000ad8 d .C23_414
+00000b20 d .C23_418
+00000afc d .C23_420
+00000aaa d .C23_421
+000009ea d .C23_422
+0000098a d .C23_423
+00000ad7 d .C23_424
+00000ae0 d .C23_426
+00000970 d .C23_427
+00000a1a d .C23_428
+00000ae4 d .C23_429
+00000ab8 d .C23_430
+00000adc d .C23_432
+000009b3 d .C23_433
+00000aec d .C23_435
+00000af0 d .C23_436
+00000998 d .C23_437
+00000af4 d .C23_438
+00000ae8 d .C23_439
+000009dc d .C23_440
+00000af8 d .C23_442
+000009c1 d .C23_443
+00000b04 d .C23_444
+00000b08 d .C23_445
+00000a9c d .C23_446
+00000b10 d .C23_448
+00000a22 d .C23_449
+00000b1c d .C23_450
+00000a06 d .C23_451
+00000b14 d .C23_504
+00000c68 d .C24_283
+00000c64 d .C24_285
+00000c74 d .C24_305
+00000c6c d .C24_308
+00000c58 d .C24_311
+00000c80 d .C24_340
+00000c7c d .C24_341
+00000b30 d .C24_404
+00000c54 d .C24_406
+00000c78 d .C24_410
+00000c70 d .C24_412
+00000c2a d .C24_413
+00000ba6 d .C24_414
+00000c22 d .C24_415
+00000c51 d .C24_416
+00000bd6 d .C24_417
+00000c09 d .C24_418
+00000c38 d .C24_419
+00000c5c d .C24_420
+00000c60 d .C24_421
+00000b8e d .C24_423
+00000bbe d .C24_425
+00000bf1 d .C24_427
+00000e74 d .C25_283
+00000e68 d .C25_285
+00000e4c d .C25_335
+00000c84 d .C25_397
+00000c88 d .C25_398
+00000d89 d .C25_399
+00000e64 d .C25_407
+00000e58 d .C25_408
+00000de8 d .C25_412
+00000e70 d .C25_413
+00000dec d .C25_415
+00000cc4 d .C25_416
+00000df0 d .C25_417
+00000c89 d .C25_418
+00000df4 d .C25_419
+00000df8 d .C25_420
+00000cb7 d .C25_421
+00000dfc d .C25_422
+00000e00 d .C25_423
+00000cde d .C25_424
+00000e04 d .C25_425
+00000cf1 d .C25_426
+00000cc6 d .C25_427
+00000e18 d .C25_429
+00000cdf d .C25_430
+00000e20 d .C25_431
+00000cfd d .C25_432
+00000e2c d .C25_433
+00000d20 d .C25_434
+00000d44 d .C25_435
+00000e08 d .C25_436
+00000e0c d .C25_437
+00000d4e d .C25_438
+00000e24 d .C25_439
+00000d4b d .C25_440
+00000e10 d .C25_441
+00000e14 d .C25_446
+00000d7e d .C25_447
+00000e1c d .C25_449
+00000e3c d .C25_450
+00000e30 d .C25_451
+00000e34 d .C25_452
+00000e38 d .C25_453
+00000e28 d .C25_454
+00000e40 d .C25_455
+00000e44 d .C25_456
+00000e48 d .C25_457
+00000d76 d .C25_458
+00000e50 d .C25_459
+00000d80 d .C25_460
+00000e54 d .C25_461
+00000e5c d .C25_462
+00000e60 d .C25_463
+00000d6b d .C25_464
+00000d51 d .C25_465
+00000d75 d .C25_466
+00000e6c d .C25_467
+00000ec8 d .C26_337
+00000e78 d .C26_405
+00000e80 d .C26_406
+00000ea4 d .C26_407
+00000eaa d .C26_408
+00000eb2 d .C26_409
+00000eb9 d .C26_411
+00000ebd d .C26_412
+00000eab d .C26_413
+00000ecc d .C27_285
+00000ed0 d .C27_404
+00000040 d .C2_283
+0000003c d .C2_285
+00000058 d .C3_283
+0000004c d .C3_285
+00000054 d .C3_335
+00000050 d .C3_429
+00000074 d .C4_283
+00000068 d .C4_285
+00000070 d .C4_335
+0000006c d .C4_440
+00000084 d .C5_283
+00000080 d .C5_285
+00000098 d .C6_283
+0000008c d .C6_285
+00000094 d .C6_335
+00000090 d .C6_429
+000000b4 d .C7_283
+000000a8 d .C7_285
+000000b0 d .C7_335
+000000ac d .C7_440
+000000c4 d .C8_283
+000000c0 d .C8_285
+000000d8 d .C9_283
+000000cc d .C9_285
+000000d4 d .C9_307
+000000d0 d .C9_440
+000000f8 d .STATICS10
+00000108 d .STATICS11
+00000120 d .STATICS12
+00000138 d .STATICS13
+00000400 d .STATICS17
+00000048 d .STATICS2
+00000060 d .STATICS3
+00000078 d .STATICS4
+00000088 d .STATICS5
+000000a0 d .STATICS6
+000000b8 d .STATICS7
+000000c8 d .STATICS8
+000000e0 d .STATICS9
+0000482c t __ioipsl_getincom_get_fil_END
+000101c4 t __ioipsl_getincom_get_findkey_END
+0000ffaa t __ioipsl_getincom_get_qtyp_END
+00005867 t __ioipsl_getincom_get_rdb_END
+000064c4 t __ioipsl_getincom_get_wdb_END
+0000a033 t __ioipsl_getincom_getin_allockeys_END
+0000c2fe t __ioipsl_getincom_getin_allocmem_END
+0000dbbb t __ioipsl_getincom_getin_alloctxt_END
+00008d92 t __ioipsl_getincom_getin_checkcohe_END
+00008744 t __ioipsl_getincom_getin_decrypt_END
+0000fd0f t __ioipsl_getincom_getin_dump_END
+000065ae t __ioipsl_getincom_getin_read_END
+000071d8 t __ioipsl_getincom_getin_readdef_END
+0000905e t __ioipsl_getincom_getin_skipafew_END
+00001f0f t __ioipsl_getincom_getinc1d_END
+0000242e t __ioipsl_getincom_getinc2d_END
+00001ad3 t __ioipsl_getincom_getincs_END
+00000704 t __ioipsl_getincom_getini1d_END
+00000ba9 t __ioipsl_getincom_getini2d_END
+000001ec t __ioipsl_getincom_getinis_END
+00002b34 t __ioipsl_getincom_getinl1d_END
+00002fd9 t __ioipsl_getincom_getinl2d_END
+0000261c t __ioipsl_getincom_getinls_END
+00001404 t __ioipsl_getincom_getinr1d_END
+000018a9 t __ioipsl_getincom_getinr2d_END
+00000d95 t __ioipsl_getincom_getinrs_END
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_str_free
+         U ftn_str_index
+         U ftn_str_malloc
+         U ftn_strcmp
+         U ioipsl_errioipsl_
+00000014 C ioipsl_errioipsl_12_
+         U ioipsl_errioipsl_ipslerr_
+00000000 T ioipsl_getincom_
+00000010 D ioipsl_getincom_12_
+00000000 D ioipsl_getincom_13_
+000002b4 C ioipsl_getincom_4_
+00002710 C ioipsl_getincom_5_
+00002fe0 T ioipsl_getincom_get_fil_
+0000ffb0 T ioipsl_getincom_get_findkey_
+0000fd20 T ioipsl_getincom_get_qtyp_
+00004830 T ioipsl_getincom_get_rdb_
+00005870 T ioipsl_getincom_get_wdb_
+00009070 T ioipsl_getincom_getin_allockeys_
+0000a040 T ioipsl_getincom_getin_allocmem_
+0000c310 T ioipsl_getincom_getin_alloctxt_
+00008750 T ioipsl_getincom_getin_checkcohe_
+000071e0 T ioipsl_getincom_getin_decrypt_
+0000dbc0 T ioipsl_getincom_getin_dump_
+000064d0 T ioipsl_getincom_getin_read_
+000065c0 T ioipsl_getincom_getin_readdef_
+00008da0 T ioipsl_getincom_getin_skipafew_
+00001ae0 T ioipsl_getincom_getinc1d_
+00001f20 T ioipsl_getincom_getinc2d_
+000018b0 T ioipsl_getincom_getincs_
+000001f0 T ioipsl_getincom_getini1d_
+00000710 T ioipsl_getincom_getini2d_
+00000010 T ioipsl_getincom_getinis_
+00002620 T ioipsl_getincom_getinl1d_
+00002b40 T ioipsl_getincom_getinl2d_
+00002440 T ioipsl_getincom_getinls_
+00000da0 T ioipsl_getincom_getinr1d_
+00001410 T ioipsl_getincom_getinr2d_
+00000bb0 T ioipsl_getincom_getinrs_
+         U ioipsl_stringop_
+00000078 C ioipsl_stringop_8_
+         U ioipsl_stringop_cmpblank_
+         U ioipsl_stringop_nocomma_
+         U ioipsl_stringop_strlowercase_
+         U pgf90_adjustl
+         U pgf90_alloc
+         U pgf90_allocated
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90_present
+         U pgf90_presentc
+         U pgf90_ptr_alloc
+         U pgf90_template1v
+         U pgf90_trim
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtr_intern_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_intern_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_ldw_intern_init
+         U pgf90io_open
+         U pgf90io_src_info
+
+ioipsl_stringop.o:
+00000000 A ..Dm_ioipsl_stringop
+00000000 b .BSS10
+0000008c d .C10_285
+00000090 d .C10_298
+00000088 d .C10_315
+00000078 d .C2_308
+0000007c d .C5_285
+00000080 d .C5_331
+00000084 d .C6_303
+00000085 d .C6_304
+000000b5 t __ioipsl_stringop_cmpblank_END
+00000160 t __ioipsl_stringop_cntpos_END
+00000a40 t __ioipsl_stringop_find_sig_END
+0000038a t __ioipsl_stringop_find_str_END
+000001ab t __ioipsl_stringop_findpos_END
+00000594 t __ioipsl_stringop_gensig_END
+000003f1 t __ioipsl_stringop_nocomma_END
+00000461 t __ioipsl_stringop_strlowercase_END
+000004d1 t __ioipsl_stringop_struppercase_END
+         U ftn_str_copy
+         U ftn_str_index
+         U ftn_strcmp
+00000000 T ioipsl_stringop_
+00000000 D ioipsl_stringop_8_
+00000010 T ioipsl_stringop_cmpblank_
+000000c0 T ioipsl_stringop_cntpos_
+000005a0 T ioipsl_stringop_find_sig_
+000001b0 T ioipsl_stringop_find_str_
+00000170 T ioipsl_stringop_findpos_
+000004e0 T ioipsl_stringop_gensig_
+00000390 T ioipsl_stringop_nocomma_
+00000400 T ioipsl_stringop_strlowercase_
+00000470 T ioipsl_stringop_struppercase_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90_ptr_alloc
+         U pgf90_template1v
+         U pgf90_trim
+         U pghpf_minlocs
+
+isamax.o:
+00000000 b .BSS1
+00000000 d .C1_331
+0000008a t __isamax_END
+00000010 T isamax_
+         U pgf90_compiled
+
+isitor.o:
+00000000 b .BSS1
+000000a4 d .C1_283
+000000a0 d .C1_285
+00000000 d .C1_308
+00000020 d .C1_310
+0000008c d .C1_312
+00000094 d .C1_313
+00000001 d .C1_314
+00000016 d .C1_317
+00000098 d .C1_319
+00000090 d .C1_322
+00000073 d .C1_323
+0000009c d .C1_324
+00000330 t __isitor_END
+         U ftn_str_copy
+         U ftn_strcmp
+00000010 T isitor_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+ismax.o:
+00000000 b .BSS1
+0000007c t __ismax_END
+00000010 T ismax_
+         U pgf90_compiled
+
+ismin.o:
+00000000 b .BSS1
+0000007c t __ismin_END
+00000010 T ismin_
+         U pgf90_compiled
+
+jthermcalc.o:
+00000000 b .BSS1
+00000040 d .C1_287
+00000038 d .C1_288
+00000030 d .C1_290
+00000044 d .C1_315
+00000020 d .C1_473
+00000001 d .C1_474
+00000000 d .C1_475
+00000024 d .C1_478
+0000002c d .C1_479
+00000034 d .C1_482
+0000003c d .C1_492
+00000028 d .C1_809
+00000010 d .C1_946
+00002146 t __jthermcalc_END
+         U __mth_i_expx
+         U column_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+         U interpfast_
+00000010 T jthermcalc_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+lnblnk.o:
+00000000 d .C1_302
+00000055 t __lnblnk_END
+         U ftn_strcmp
+00000010 T lnblnk_
+         U pgf90_compiled
+
+lwb.o:
+00000000 b .BSS1
+00000008 d .C1_436
+00000004 d .C1_437
+00000000 d .C1_438
+00000530 t __lwb_END
+000000c0 C callkeys_
+06b3a000 C ksicom_
+00000010 T lwb_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+lwdiff.o:
+00000000 b .BSS1
+00000004 d .C1_283
+00000000 d .C1_290
+000007ae t __lwdiff_END
+000000c0 C callkeys_
+00000028 C comcstfi_
+         U flusv_
+06b3a000 C ksicom_
+00000010 T lwdiff_
+         U pgf90_compiled
+0000006c C yomaer_
+000000e0 C yomlw_
+
+lwflux.o:
+00000000 b .BSS1
+00000134 d .C1_283
+00000130 d .C1_285
+000000c4 d .C1_287
+000000f8 d .C1_318
+00000108 d .C1_324
+000000cc d .C1_426
+000000c0 d .C1_471
+00000063 d .C1_492
+000000c8 d .C1_494
+00000000 d .C1_497
+00000124 d .C1_499
+00000128 d .C1_500
+000000d0 d .C1_502
+000000e8 d .C1_503
+00000018 d .C1_504
+0000001f d .C1_505
+00000012 d .C1_506
+0000002a d .C1_507
+000000d4 d .C1_509
+0000012c d .C1_512
+000000d8 d .C1_514
+000000dc d .C1_515
+000000e0 d .C1_516
+000000e4 d .C1_517
+000000ec d .C1_518
+00000120 d .C1_519
+00000031 d .C1_520
+000000f0 d .C1_521
+00000037 d .C1_522
+000000f4 d .C1_523
+0000003e d .C1_524
+000000fc d .C1_525
+00000043 d .C1_526
+00000100 d .C1_527
+00000048 d .C1_528
+00000104 d .C1_529
+0000004d d .C1_530
+0000010c d .C1_531
+00000052 d .C1_532
+00000110 d .C1_533
+00000057 d .C1_534
+00000114 d .C1_535
+0000005b d .C1_536
+00000118 d .C1_537
+0000005f d .C1_538
+0000011c d .C1_539
+000000b8 d .C1_540
+00002727 t __lwflux_END
+000000c0 C callkeys_
+00031f3c C comg1dc_
+0000001c C comg1di_
+00000008 C comg1dl_
+06b3a000 C ksicom_
+         U lwdiff_
+00000010 T lwflux_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pgf90io_unf_end
+         U pgf90io_unf_init
+         U pgf90io_unf_write
+000000e0 C yomlw_
+         U zerophys_
+
+lwi.o:
+00000000 b .BSS1
+00000004 d .C1_287
+00000000 d .C1_288
+00000705 t __lwi_END
+000000c0 C callkeys_
+00000028 C comcstfi_
+00031f3c C comg1dc_
+0000001c C comg1di_
+00000008 C comg1dl_
+06b3a000 C ksicom_
+00000010 T lwi_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+lwmain.o:
+00000000 b .BSS1
+00000000 d .STATICS1
+00000412 t __lwmain_END
+000000c0 C callkeys_
+00031f3c C comg1dc_
+0000001c C comg1di_
+00000008 C comg1dl_
+06b3a000 C ksicom_
+         U lwb_
+         U lwflux_
+         U lwi_
+00000010 T lwmain_
+         U lwu_
+         U lwxb_
+         U lwxd_
+         U lwxn_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+lwtt.o:
+00000000 b .BSS1
+00000158 t __lwtt_END
+         U __mth_i_rpowrx
+06b3a000 C ksicom_
+00000010 T lwtt_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+lwu.o:
+00000000 b .BSS1
+00000020 d .C1_287
+00000028 d .C1_288
+00000010 d .C1_478
+00000014 d .C1_479
+00000018 d .C1_480
+0000001c d .C1_482
+00000024 d .C1_483
+00000000 d .C1_672
+00000981 t __lwu_END
+         U __mth_i_expx
+000000c0 C callkeys_
+00000028 C comcstfi_
+06b3a000 C ksicom_
+00000010 T lwu_
+         U pgf90_compiled
+0000006c C yomaer_
+000000e0 C yomlw_
+         U zerophys_
+
+lwxb.o:
+00000000 b .BSS1
+00000004 d .C1_288
+00000000 d .C1_325
+0000082e t __lwxb_END
+000000c0 C callkeys_
+06b3a000 C ksicom_
+         U lwtt_
+00000010 T lwxb_
+         U pgf90_compiled
+000000e0 C yomlw_
+
+lwxd.o:
+00000000 b .BSS1
+00000008 d .C1_288
+00000004 d .C1_325
+00000000 d .C1_357
+00000987 t __lwxd_END
+000000c0 C callkeys_
+06b3a000 C ksicom_
+         U lwtt_
+00000010 T lwxd_
+         U pgf90_compiled
+000000e0 C yomlw_
+         U zerophys_
+
+lwxn.o:
+00000000 b .BSS1
+000000b4 d .C1_283
+000000b8 d .C1_285
+00000090 d .C1_288
+00000094 d .C1_290
+000000bc d .C1_325
+000000a4 d .C1_340
+000000a8 d .C1_425
+0000002a d .C1_450
+00000098 d .C1_452
+00000000 d .C1_456
+000000ac d .C1_458
+0000009c d .C1_460
+00000016 d .C1_461
+000000a0 d .C1_462
+0000007d d .C1_463
+00000083 d .C1_464
+000000b0 d .C1_465
+00001587 t __lwxn_END
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+000000c0 C callkeys_
+06b3a000 C ksicom_
+         U lwtt_
+00000010 T lwxn_
+         U pgf90_compiled
+         U pgf90_exit
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000000e0 C yomlw_
+
+mkstat.o:
+00000000 b .BSS1
+000000ac d .C1_283
+000000a8 d .C1_285
+000000b0 d .C1_287
+000000b8 d .C1_335
+000000a0 d .C1_336
+000000a4 d .C1_338
+00000000 d .C1_628
+00000008 d .C1_629
+00000010 d .C1_630
+00000019 d .C1_631
+00000021 d .C1_632
+00000094 d .C1_633
+0000009c d .C1_635
+00000025 d .C1_636
+0000007c d .C1_638
+0000008d d .C1_643
+00000088 d .C1_644
+0000008e d .C1_645
+000000b4 d .C1_702
+00000098 d .C1_791
+000000c0 d .STATICS1
+00000d6b t __mkstats_END
+         U ftn_str_cpy1
+00000010 T mkstats_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000068 C sttcom_
+
+moldiff.o:
+00000000 b .BSS1
+0002b260 b .BSS2
+0002b3f8 b .BSS3
+0002b400 b .BSS4
+00000344 d .C1_1030
+000001e0 d .C1_1118
+00000320 d .C1_283
+0000031c d .C1_285
+00000330 d .C1_287
+0000034c d .C1_288
+0000032c d .C1_290
+00000328 d .C1_424
+00000318 d .C1_478
+00000324 d .C1_484
+00000314 d .C1_539
+00000234 d .C1_574
+000002b0 d .C1_576
+00000000 d .C1_579
+000002b4 d .C1_582
+0000000c d .C1_583
+000002b8 d .C1_585
+0000002d d .C1_586
+000002bc d .C1_587
+0000004d d .C1_588
+000002c0 d .C1_589
+0000006c d .C1_590
+000002c4 d .C1_591
+0000008d d .C1_592
+000002c8 d .C1_593
+000000ad d .C1_594
+000002cc d .C1_595
+000000cd d .C1_596
+000002d0 d .C1_597
+000000ec d .C1_598
+000002d4 d .C1_599
+0000010c d .C1_600
+000002d8 d .C1_601
+0000012c d .C1_602
+000002dc d .C1_603
+0000014d d .C1_604
+000002e0 d .C1_605
+0000016f d .C1_606
+000002e4 d .C1_607
+0000018f d .C1_608
+000002e8 d .C1_609
+000001af d .C1_610
+00000358 d .C1_612
+00000354 d .C1_613
+00000350 d .C1_614
+000002ec d .C1_615
+000002f8 d .C1_616
+000002f4 d .C1_618
+00000334 d .C1_619
+000002fc d .C1_620
+00000300 d .C1_622
+000001f0 d .C1_623
+00000304 d .C1_624
+0000021d d .C1_625
+00000308 d .C1_626
+0000022e d .C1_627
+0000030c d .C1_628
+00000310 d .C1_629
+0000028d d .C1_630
+00000338 d .C1_633
+00000340 d .C1_634
+0000033c d .C1_635
+00000348 d .C1_637
+0000035c d .C1_639
+000002f0 d .C1_933
+000003d0 d .C2_287
+0000039c d .C2_306
+000003b6 d .C2_311
+000003d4 d .C3_287
+00000494 d .C4_283
+00000490 d .C4_285
+0000049c d .C4_287
+00000498 d .C4_288
+00000403 d .C4_316
+00000480 d .C4_318
+00000488 d .C4_319
+000003d8 d .C4_320
+0000048c d .C4_324
+00000484 d .C4_326
+0000045c d .C4_327
+00000470 d .C4_422
+00000360 d .STATICS1
+000025e6 t __lubksb_END
+00002b68 t __ludcmp_END
+00002341 t __moldiff_END
+         U __mth_i_alogx
+         U __mth_i_expx
+         U __mth_i_rpowrx
+00002495 t __tridag_END
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0034bc00 C conc_
+000024a0 T lubksb_
+000025f0 T ludcmp_
+00000010 T moldiff_
+         U moldiffcoeff_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00002350 T tridag_
+         U zerophys_
+
+moldiffcoeff.o:
+00000000 b .BSS1
+000002fc d .C1_283
+000002f0 d .C1_285
+000002e0 d .C1_287
+000002ec d .C1_375
+000002ac d .C1_391
+000002d8 d .C1_456
+000002d4 d .C1_474
+0000023a d .C1_504
+00000298 d .C1_506
+00000000 d .C1_507
+0000029c d .C1_513
+00000026 d .C1_514
+000002a0 d .C1_515
+0000004b d .C1_516
+000002a4 d .C1_517
+0000006f d .C1_518
+000002a8 d .C1_519
+00000095 d .C1_520
+000000ba d .C1_521
+000002b0 d .C1_522
+000000df d .C1_523
+000002b4 d .C1_524
+00000103 d .C1_525
+000002b8 d .C1_526
+00000128 d .C1_527
+000002bc d .C1_528
+0000014d d .C1_529
+000002c0 d .C1_530
+00000173 d .C1_531
+000002c4 d .C1_532
+0000019a d .C1_533
+000002c8 d .C1_534
+000001bf d .C1_535
+000002cc d .C1_536
+000001e4 d .C1_537
+000002d0 d .C1_544
+00000212 d .C1_545
+000002dc d .C1_546
+000002f8 d .C1_547
+00000229 d .C1_548
+00000233 d .C1_549
+000002e4 d .C1_551
+000002e8 d .C1_552
+000002f4 d .C1_553
+00000300 d .STATICS1
+00001030 t __moldiffcoeff_END
+000000c0 C callkeys_
+00661074 C chimiedata_
+0000e104 C comdiurn_
+0034bc00 C conc_
+00000010 T moldiffcoeff_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_close
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+molvis.o:
+00000000 b .BSS1
+00000098 d .C1_283
+00000094 d .C1_285
+0000009c d .C1_287
+000000b4 d .C1_288
+00000090 d .C1_352
+000000a0 d .C1_356
+000000a4 d .C1_379
+0000008c d .C1_398
+000000b0 d .C1_428
+00000000 d .C1_431
+00000084 d .C1_433
+00000088 d .C1_434
+00000058 d .C1_435
+000000ac d .C1_441
+000000a8 d .C1_442
+000000b8 d .STATICS1
+00000700 t __molvis_END
+         U __mth_i_rpowrx
+00661074 C chimiedata_
+00000028 C comcstfi_
+0034bc00 C conc_
+00000010 T molvis_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000189e4 C surfdat_
+
+mucorr.o:
+00000000 b .BSS1
+0000000c d .C1_287
+00000014 d .C1_288
+00000008 d .C1_290
+00000000 d .C1_319
+00000004 d .C1_320
+00000010 d .C1_321
+00000018 d .C1_381
+         U __mth_i_atanx
+         U __mth_i_cosx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+00000301 t __mucorr_END
+00000010 T mucorr_
+         U pgf90_compiled
+
+mufract.o:
+00000000 b .BSS1
+00000014 d .C1_287
+0000000c d .C1_288
+00000010 d .C1_290
+00000000 d .C1_315
+00000008 d .C1_317
+00000004 d .C1_348
+         U __mth_i_atanx
+         U __mth_i_cosx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+000002a8 t __mufract_END
+00000010 T mufract_
+         U pgf90_compiled
+
+multipl.o:
+0000004b t __multipl_END
+00000010 T multipl_
+         U pgf90_compiled
+
+mxm.o:
+00000000 b .BSS1
+0000017f t __mxm_END
+00000010 T mxm_
+         U pgf90_compiled
+
+mxv.o:
+00000000 b .BSS1
+000000bd t __mxv_END
+00000010 T mxv_
+         U pgf90_compiled
+
+mxva.o:
+00000000 b .BSS1
+000000cd t __mxva_END
+00000010 T mxva_
+         U pgf90_compiled
+
+mywrite.o:
+00000000 b .BSS1
+00000138 d .C1_283
+00000134 d .C1_285
+000000f4 d .C1_311
+000000ac d .C1_316
+00000034 d .C1_326
+000000a0 d .C1_328
+0000012c d .C1_329
+00000000 d .C1_330
+00000130 d .C1_334
+000000a4 d .C1_335
+000000a8 d .C1_337
+000000b0 d .C1_338
+000000b4 d .C1_339
+000000b8 d .C1_340
+000000bc d .C1_341
+000000f8 d .C1_342
+00000108 d .C1_343
+000000c0 d .C1_345
+0000011c d .C1_346
+000000c4 d .C1_347
+000000c8 d .C1_348
+000000cc d .C1_349
+000000d0 d .C1_350
+00000015 d .C1_351
+00000110 d .C1_352
+0000001d d .C1_353
+000000d4 d .C1_354
+00000124 d .C1_355
+000000d8 d .C1_357
+00000114 d .C1_358
+0000001f d .C1_359
+000000dc d .C1_364
+000000e0 d .C1_365
+000000e4 d .C1_366
+000000e8 d .C1_367
+000000ec d .C1_368
+000000f0 d .C1_369
+000000fc d .C1_370
+00000100 d .C1_371
+00000022 d .C1_372
+00000104 d .C1_373
+0000010c d .C1_374
+00000032 d .C1_375
+00000033 d .C1_376
+00000023 d .C1_377
+00000028 d .C1_378
+0000002d d .C1_379
+00000118 d .C1_380
+00000120 d .C1_381
+00000128 d .C1_383
+00000088 d .C1_384
+00000090 d .C1_385
+000017f9 t __mywrite_END
+         U ftn_str_copy
+         U ftn_strcmp
+         U isitor_
+         U ismax_
+         U ismin_
+         U lnblnk_
+00000010 T mywrite_
+         U pgf90_compiled
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U to36_
+
+newcondens.o:
+00000000 b .BSS1
+0043bb80 b .BSS2
+000000d0 d .C1_1164
+00000240 d .C1_283
+0000023c d .C1_285
+0000020c d .C1_287
+00000210 d .C1_288
+00000208 d .C1_289
+000001b0 d .C1_399
+00000218 d .C1_552
+00000228 d .C1_554
+00000149 d .C1_576
+000001ac d .C1_578
+00000230 d .C1_579
+00000000 d .C1_581
+00000234 d .C1_585
+000001b8 d .C1_586
+000001b4 d .C1_588
+0000001c d .C1_589
+000001bc d .C1_590
+00000224 d .C1_591
+00000033 d .C1_592
+0000004e d .C1_593
+000001c0 d .C1_594
+00000055 d .C1_595
+00000066 d .C1_596
+000001c4 d .C1_597
+000001c8 d .C1_598
+000001cc d .C1_599
+000001d4 d .C1_601
+000001d0 d .C1_602
+000001d8 d .C1_603
+00000069 d .C1_604
+000001dc d .C1_605
+00000078 d .C1_606
+000001e0 d .C1_607
+00000097 d .C1_608
+00000238 d .C1_609
+000001e4 d .C1_610
+000000a2 d .C1_611
+000001e8 d .C1_612
+000000a7 d .C1_613
+000001ec d .C1_615
+000001f0 d .C1_616
+000001f4 d .C1_617
+000001f8 d .C1_618
+000001fc d .C1_619
+000000ae d .C1_620
+000000c9 d .C1_621
+00000200 d .C1_622
+00000204 d .C1_623
+00000214 d .C1_627
+00000102 d .C1_628
+000000e0 d .C1_629
+0000021c d .C1_630
+000001a2 d .C1_631
+000001a8 d .C1_632
+00000220 d .C1_633
+00000126 d .C1_634
+0000022c d .C1_635
+000002f4 d .C2_283
+000002f0 d .C2_285
+000002fc d .C2_287
+00000300 d .C2_288
+000002f8 d .C2_290
+00000270 d .C2_321
+000002e4 d .C2_323
+000002e8 d .C2_324
+000002c9 d .C2_325
+000002ec d .C2_329
+00000260 d .C2_410
+00000248 d .STATICS1
+         U __mth_i_alogx
+00002a60 t __newcondens_END
+0000300b t __vl1d_END
+000000c0 C callkeys_
+         U co2snow_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000a68 C comvert_
+         U ftn_strcmp
+00000010 T newcondens_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U ssum_
+000189e4 C surfdat_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00002a70 T vl1d_
+
+newsedim.o:
+00000000 b .BSS1
+000000b4 d .C1_283
+000000b0 d .C1_285
+000000d4 d .C1_287
+000000d0 d .C1_288
+000000d8 d .C1_289
+000000b8 d .C1_317
+00000032 d .C1_359
+00000094 d .C1_361
+000000a4 d .C1_362
+00000000 d .C1_365
+000000a8 d .C1_367
+00000098 d .C1_369
+00000012 d .C1_370
+0000009c d .C1_371
+0000002a d .C1_372
+000000ac d .C1_373
+000000a0 d .C1_374
+00000089 d .C1_375
+000000bc d .C1_378
+000000c8 d .C1_379
+000000c0 d .C1_380
+000000c4 d .C1_382
+000000cc d .C1_383
+000000e0 d .STATICS1
+         U __mth_i_expx
+000007ab t __newsedim_END
+00000028 C comcstfi_
+00000010 T newsedim_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U vlz_fi_
+
+nirco2abs.o:
+00000000 b .BSS1
+00000014 d .C1_287
+00000024 d .C1_288
+00000008 d .C1_290
+00000004 d .C1_402
+0000001c d .C1_403
+00000018 d .C1_404
+00000000 d .C1_405
+0000000c d .C1_406
+00000020 d .C1_408
+00000010 d .C1_469
+         U __mth_i_cosx
+         U __mth_i_rpowrx
+         U __mth_i_sincosx
+00000425 t __nirco2abs_END
+000000c0 C callkeys_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+00000010 T nirco2abs_
+         U pgf90_compiled
+         U solang_
+
+nltecool.o:
+00000000 b .BSS1
+00000098 b .BSS2
+000000a8 b .BSS3
+00000040 d .C1_287
+00000058 d .C1_288
+00000054 d .C1_290
+00000010 d .C1_302
+00000060 d .C1_309
+00000004 d .C1_376
+00000008 d .C1_377
+0000005c d .C1_378
+0000000c d .C1_379
+00000014 d .C1_383
+00000018 d .C1_384
+0000001c d .C1_385
+00000020 d .C1_386
+00000024 d .C1_387
+00000030 d .C1_388
+0000002c d .C1_389
+00000028 d .C1_390
+0000003c d .C1_391
+00000038 d .C1_392
+00000034 d .C1_393
+00000044 d .C1_394
+00000048 d .C1_395
+0000004c d .C1_396
+00000050 d .C1_397
+00000000 d .C1_413
+00000708 d .C2_288
+00000700 d .C2_310
+00000704 d .C2_311
+000006f0 d .C2_357
+00000728 d .C3_288
+00000720 d .C3_314
+00000724 d .C3_315
+00000710 d .C3_373
+00000068 d .STATICS1
+00000d14 t __interp1_END
+00000e9a t __interp3_END
+         U __mth_i_expx
+00000bf6 t __nltecool_END
+00000c00 T interp1_
+00000d20 T interp3_
+00000010 T nltecool_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+
+nlthermeq.o:
+00000000 b .BSS1
+000000ac d .C1_283
+000000a8 d .C1_285
+00000088 d .C1_290
+00000080 d .C1_333
+00000094 d .C1_336
+0000009c d .C1_344
+00000000 d .C1_428
+0000007c d .C1_430
+00000090 d .C1_435
+00000084 d .C1_437
+0000008c d .C1_439
+00000098 d .C1_444
+00000058 d .C1_445
+000000a0 d .C1_448
+000000a4 d .C1_449
+000000b0 d .STATICS1
+00000357 t __nlthermeq_END
+000000c0 C callkeys_
+         U ismax_
+06b3a000 C ksicom_
+00000010 T nlthermeq_
+         U pgf90_compiled
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000000e0 C yomlw_
+
+orbite.o:
+00000000 d .C1_288
+00000004 d .C1_339
+         U __mth_i_asinx
+         U __mth_i_cosx
+         U __mth_i_sinx
+00000094 t __orbite_END
+00000028 C comcstfi_
+00000010 T orbite_
+         U pgf90_compiled
+00000038 C planet_
+
+orodrag.o:
+00000000 b .BSS1
+00000018 d .C1_287
+0000001c d .C1_288
+00000014 d .C1_289
+00000020 d .C1_290
+00000000 d .C1_434
+00000004 d .C1_435
+0000000c d .C1_436
+00000008 d .C1_437
+00000010 d .C1_438
+         U __mth_i_cosx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+00000860 t __orodrag_END
+00000028 C comcstfi_
+         U gwprofil_
+         U gwstress_
+00000010 T orodrag_
+         U orosetup_
+         U pgf90_compiled
+00000034 C yoegwd_
+
+orosetup.o:
+00000000 b .BSS1
+000000b8 d .C1_283
+000000b4 d .C1_285
+000000c0 d .C1_287
+000000d0 d .C1_288
+000000cc d .C1_290
+000000bc d .C1_439
+00000090 d .C1_442
+000000c8 d .C1_443
+00000094 d .C1_446
+00000098 d .C1_447
+000000a0 d .C1_448
+0000009c d .C1_449
+00000000 d .C1_450
+000000a4 d .C1_452
+000000a8 d .C1_453
+00000057 d .C1_454
+0000006e d .C1_457
+000000ac d .C1_459
+000000b0 d .C1_460
+000000c4 d .C1_776
+00000080 d .C1_866
+         U __mth_i_atanx
+         U __mth_i_cosx
+         U __mth_i_sinx
+00001e7a t __orosetup_END
+00000028 C comcstfi_
+00000010 T orosetup_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000034 C yoegwd_
+
+param_read.o:
+00000000 b .BSS1
+00000384 d .C1_283
+00000378 d .C1_285
+000002a0 d .C1_299
+000002e4 d .C1_319
+00000360 d .C1_437
+0000021d d .C1_455
+0000027c d .C1_457
+00000010 d .C1_458
+00000000 d .C1_459
+00000280 d .C1_462
+00000013 d .C1_463
+000002a4 d .C1_466
+00000284 d .C1_468
+00000042 d .C1_469
+00000288 d .C1_470
+0000005e d .C1_471
+0000006f d .C1_472
+0000028c d .C1_473
+00000070 d .C1_474
+00000290 d .C1_475
+0000009c d .C1_476
+00000294 d .C1_477
+000000b6 d .C1_478
+00000298 d .C1_479
+000000e3 d .C1_480
+0000029c d .C1_481
+00000100 d .C1_482
+000002a8 d .C1_484
+000002ec d .C1_485
+00000135 d .C1_486
+000002ac d .C1_487
+000002f4 d .C1_488
+00000146 d .C1_489
+000002b0 d .C1_490
+000002fc d .C1_491
+00000157 d .C1_492
+000002b4 d .C1_493
+00000304 d .C1_494
+00000168 d .C1_495
+000002b8 d .C1_496
+0000030c d .C1_497
+00000179 d .C1_498
+000002bc d .C1_499
+00000314 d .C1_500
+0000018a d .C1_501
+000002c0 d .C1_502
+0000031c d .C1_503
+0000019b d .C1_504
+000002c4 d .C1_505
+00000324 d .C1_506
+000001ac d .C1_507
+000002c8 d .C1_508
+00000334 d .C1_509
+000001bd d .C1_511
+00000300 d .C1_512
+000002cc d .C1_513
+0000032c d .C1_514
+000001cc d .C1_515
+000002d0 d .C1_516
+00000364 d .C1_517
+000001db d .C1_518
+000002d4 d .C1_520
+000002d8 d .C1_523
+000002dc d .C1_524
+000002e0 d .C1_525
+00000380 d .C1_527
+00000374 d .C1_529
+000002e8 d .C1_531
+000002f0 d .C1_532
+000002f8 d .C1_533
+00000308 d .C1_536
+00000370 d .C1_537
+00000310 d .C1_539
+00000318 d .C1_540
+00000320 d .C1_541
+00000328 d .C1_543
+00000330 d .C1_545
+00000338 d .C1_547
+0000033c d .C1_548
+00000340 d .C1_550
+00000344 d .C1_551
+00000350 d .C1_552
+000001ea d .C1_553
+00000348 d .C1_555
+0000034c d .C1_556
+00000354 d .C1_557
+000001f8 d .C1_558
+00000358 d .C1_559
+0000035c d .C1_560
+00000209 d .C1_562
+00000368 d .C1_563
+0000036c d .C1_564
+0000037c d .C1_565
+00000388 d .STATICS1
+000030c3 t __param_read_END
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+         U ftn_str_copy
+00067c50 C loss_
+00000010 T param_read_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90_trim
+         U pgf90io_close
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_ldr
+00000294 C phdisef_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+param_slope.o:
+00000000 b .BSS1
+00000098 d .C1_283
+00000094 d .C1_285
+000000d8 d .C1_287
+000000cc d .C1_288
+000000a0 d .C1_290
+000000d4 d .C1_316
+00000084 d .C1_327
+00000000 d .C1_328
+00000088 d .C1_330
+0000008c d .C1_331
+0000005c d .C1_334
+00000090 d .C1_336
+000000d0 d .C1_337
+0000009c d .C1_340
+000000a4 d .C1_345
+000000a8 d .C1_346
+000000ac d .C1_350
+000000b0 d .C1_351
+000000b4 d .C1_355
+000000b8 d .C1_356
+000000bc d .C1_360
+000000c0 d .C1_361
+000000c4 d .C1_364
+00000080 d .C1_468
+000000c8 d .C1_570
+000000e0 d .STATICS1
+         U __mth_i_asinx
+         U __mth_i_atan2x
+         U __mth_i_cosx
+         U __mth_i_expx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+00000c83 t __param_slope_END
+00000010 T param_slope_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_matmul_real4
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90_template2v
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+param_slope_full.o:
+00000000 b .BSS1
+0000009c d .C1_283
+00000098 d .C1_285
+000000f4 d .C1_287
+000000e8 d .C1_288
+000000bc d .C1_290
+000000ac d .C1_310
+000000a8 d .C1_312
+000000a4 d .C1_314
+000000b4 d .C1_316
+000000f0 d .C1_332
+00000088 d .C1_343
+00000000 d .C1_344
+0000008c d .C1_346
+00000090 d .C1_347
+00000061 d .C1_350
+00000094 d .C1_352
+000000ec d .C1_353
+000000b0 d .C1_357
+000000b8 d .C1_358
+000000c0 d .C1_363
+000000c4 d .C1_364
+000000c8 d .C1_368
+000000cc d .C1_369
+000000d0 d .C1_373
+000000d4 d .C1_374
+000000d8 d .C1_378
+000000dc d .C1_379
+000000e0 d .C1_382
+00000084 d .C1_484
+000000a0 d .C1_499
+000000e4 d .C1_596
+000000f8 d .STATICS1
+         U __mth_i_acosx
+         U __mth_i_asinx
+         U __mth_i_atan2x
+         U __mth_i_cosx
+         U __mth_i_expx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+00000da9 t __param_slope_full_END
+00000010 T param_slope_full_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_matmul_real4
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90_template2v
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+
+paramfoto.o:
+00000000 b .BSS1
+00000074 d .C1_283
+00000070 d .C1_285
+000000a0 d .C1_291
+000000a8 d .C1_292
+00000068 d .C1_317
+00000000 d .C1_497
+00000064 d .C1_499
+0000005b d .C1_503
+0000006c d .C1_505
+00000080 d .C1_511
+00000078 d .C1_512
+00000098 d .C1_523
+00000060 d .C1_525
+0000005f d .C1_526
+00000088 d .C1_927
+00000090 d .C1_930
+000000b0 d .STATICS1
+00002379 t __paramfoto_END
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+         U getch_
+00067c50 C loss_
+00000010 T paramfoto_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000294 C phdisef_
+         U phdisrate_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+perosat.o:
+00000000 b .BSS1
+0000008c d .C1_283
+00000088 d .C1_285
+000000ac d .C1_287
+0000009c d .C1_363
+00000084 d .C1_418
+00000000 d .C1_437
+0000007c d .C1_439
+00000080 d .C1_440
+00000059 d .C1_441
+00000090 d .C1_448
+00000098 d .C1_449
+00000094 d .C1_450
+000000a0 d .C1_451
+000000a8 d .C1_453
+000000a4 d .C1_531
+000000b0 d .STATICS1
+         U __mth_i_rpowrx
+000003c2 t __perosat_END
+00661074 C chimiedata_
+00000028 C comcstfi_
+0034bc00 C conc_
+00000010 T perosat_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+phdisrate.o:
+00000000 b .BSS1
+00000004 d .C1_443
+00000001 d .C1_444
+00000000 d .C1_445
+0000041e t __phdisrate_END
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00067c50 C loss_
+         U pgf90_compiled
+00000294 C phdisef_
+00000010 T phdisrate_
+00067c50 C prod_
+00055e30 C uv_
+00004830 C vida_
+
+photochemist_B.o:
+00000000 b .BSS1
+00003a38 b .BSS2
+00004310 b .BSS3
+00004670 b .BSS4
+00004678 b .BSS5
+00004680 b .BSS6
+00000114 d .C1_283
+00000110 d .C1_285
+00000120 d .C1_462
+00000000 d .C1_507
+00000064 d .C1_508
+000000fc d .C1_510
+00000108 d .C1_511
+00000007 d .C1_512
+00000035 d .C1_515
+0000003c d .C1_516
+0000010c d .C1_517
+00000056 d .C1_518
+00000100 d .C1_520
+00000104 d .C1_523
+000000c4 d .C1_524
+000000e8 d .C1_525
+00000118 d .C1_527
+0000011c d .C1_529
+00000138 d .C2_288
+00000140 d .C2_292
+0000013c d .C2_388
+00000130 d .C2_506
+00000134 d .C2_511
+00000148 d .C2_513
+0000016c d .C3_288
+0000015c d .C3_290
+00000158 d .C3_326
+00000168 d .C3_350
+00000150 d .C3_351
+00000154 d .C3_407
+00000160 d .C3_408
+00000164 d .C3_409
+00000170 d .C3_414
+000001e4 d .C4_447
+000001e7 d .C4_448
+000001e9 d .C4_449
+000001ea d .C4_450
+000001ed d .C4_451
+000001ef d .C4_452
+000001f1 d .C4_453
+000001f2 d .C4_454
+000001f4 d .C4_455
+000001f6 d .C4_456
+000001f9 d .C4_457
+000001fd d .C4_458
+000001ff d .C4_459
+00000208 d .C4_461
+00000248 d .C5_445
+0000024b d .C5_446
+0000024d d .C5_447
+0000024e d .C5_448
+00000251 d .C5_449
+00000253 d .C5_450
+00000255 d .C5_451
+00000256 d .C5_452
+00000258 d .C5_453
+0000025a d .C5_454
+0000025d d .C5_455
+00000261 d .C5_456
+00000263 d .C5_457
+000002bc d .C6_287
+00000340 d .C6_288
+000002ac d .C6_351
+000002a8 d .C6_353
+000002b4 d .C6_354
+000002b0 d .C6_355
+000002c0 d .C6_356
+000002b8 d .C6_357
+000002c4 d .C6_358
+000002d8 d .C6_359
+000002cc d .C6_362
+000002c8 d .C6_363
+000002d4 d .C6_365
+000002d0 d .C6_366
+000002dc d .C6_367
+000002e4 d .C6_368
+000002e0 d .C6_369
+000002e8 d .C6_373
+00000364 d .C6_374
+000002f0 d .C6_375
+000002ec d .C6_376
+000002f8 d .C6_377
+000002f4 d .C6_378
+000002fc d .C6_379
+0000030c d .C6_380
+00000304 d .C6_381
+00000300 d .C6_382
+00000308 d .C6_383
+00000344 d .C6_385
+00000310 d .C6_386
+00000318 d .C6_387
+00000314 d .C6_388
+00000320 d .C6_389
+0000031c d .C6_390
+00000328 d .C6_391
+00000324 d .C6_392
+00000330 d .C6_393
+0000032c d .C6_394
+00000334 d .C6_395
+0000033c d .C6_397
+00000350 d .C6_398
+0000034c d .C6_400
+00000358 d .C6_401
+00000354 d .C6_402
+00000360 d .C6_403
+0000035c d .C6_404
+00000368 d .C6_405
+00000370 d .C6_406
+0000036c d .C6_407
+00000378 d .C6_408
+00000374 d .C6_409
+00000384 d .C6_410
+0000037c d .C6_411
+00000388 d .C6_413
+00000390 d .C6_415
+00000338 d .C6_508
+00000348 d .C6_543
+00000380 d .C6_550
+0000038c d .C6_553
+00000128 d .STATICS1
+00000178 d .STATICS3
+00000210 d .STATICS4
+00000270 d .STATICS5
+0000499b t __chemrates_END
+00002b55 t __chimie_b_END
+00004211 t __chimtogcm_END
+00003c95 t __gcmtochim_END
+         U __mth_i_alog10x
+         U __mth_i_alogx
+         U __mth_i_expx
+         U __mth_i_nintx
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+0000362e t __phot_END
+000007e8 t __photochemist_b_END
+000000c0 C callkeys_
+00004220 T chemrates_
+000007f0 T chimie_b_
+00661074 C chimiedata_
+00003ca0 T chimtogcm_
+         U ftn_strcmp
+00003640 T gcmtochim_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00002b60 T phot_
+00000010 T photochemist_b_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+phyetat0.o:
+00000000 b .BSS1
+00000984 d .C1_1235
+000009bc d .C1_283
+000009b8 d .C1_285
+000009a8 d .C1_330
+000009b0 d .C1_331
+000009b4 d .C1_333
+000008ec d .C1_348
+000009c0 d .C1_606
+00000898 d .C1_720
+00000825 d .C1_721
+00000894 d .C1_723
+0000098c d .C1_724
+00000000 d .C1_725
+000007e6 d .C1_732
+000006ec d .C1_733
+000006f5 d .C1_734
+000009a0 d .C1_738
+0000089c d .C1_741
+0000001b d .C1_742
+00000046 d .C1_743
+000008a0 d .C1_744
+00000066 d .C1_746
+000008a4 d .C1_747
+00000082 d .C1_748
+000008a8 d .C1_750
+000008ac d .C1_751
+000000b2 d .C1_752
+000000c2 d .C1_754
+000008b0 d .C1_755
+000000ca d .C1_756
+000008b4 d .C1_757
+000000f2 d .C1_758
+0000011b d .C1_759
+000008b8 d .C1_760
+00000124 d .C1_761
+000008bc d .C1_762
+0000014d d .C1_763
+00000177 d .C1_764
+000008c0 d .C1_765
+0000017b d .C1_766
+000008c4 d .C1_767
+0000019f d .C1_768
+000008c8 d .C1_771
+000001c4 d .C1_772
+000001dd d .C1_773
+000008cc d .C1_774
+000001e3 d .C1_775
+000008d0 d .C1_776
+00000209 d .C1_777
+000008d4 d .C1_778
+00000230 d .C1_779
+0000024d d .C1_780
+000008d8 d .C1_781
+00000256 d .C1_782
+000008dc d .C1_783
+0000027f d .C1_784
+000008e0 d .C1_785
+000002a9 d .C1_786
+000002c6 d .C1_787
+000008e4 d .C1_788
+000002ca d .C1_789
+000008e8 d .C1_790
+000002ee d .C1_791
+00000313 d .C1_792
+0000031a d .C1_793
+000008f0 d .C1_794
+0000031e d .C1_795
+000008f4 d .C1_796
+00000342 d .C1_797
+000008f8 d .C1_798
+00000367 d .C1_799
+0000036e d .C1_800
+000008fc d .C1_801
+00000372 d .C1_802
+00000900 d .C1_803
+00000396 d .C1_804
+00000904 d .C1_805
+000003bb d .C1_806
+000003c2 d .C1_807
+00000908 d .C1_808
+000003c6 d .C1_809
+0000090c d .C1_810
+000003ea d .C1_811
+00000910 d .C1_812
+0000040f d .C1_813
+00000416 d .C1_814
+00000914 d .C1_815
+0000041a d .C1_816
+00000918 d .C1_817
+0000043e d .C1_818
+0000091c d .C1_819
+00000463 d .C1_820
+0000046a d .C1_821
+00000920 d .C1_822
+00000470 d .C1_823
+00000924 d .C1_824
+00000496 d .C1_825
+00000928 d .C1_826
+000004bd d .C1_827
+000004d4 d .C1_828
+0000092c d .C1_829
+000004d9 d .C1_830
+00000930 d .C1_831
+000004fe d .C1_832
+00000934 d .C1_835
+00000529 d .C1_836
+0000052f d .C1_837
+00000938 d .C1_838
+00000531 d .C1_840
+00000547 d .C1_841
+0000093c d .C1_842
+00000553 d .C1_843
+000007a0 d .C1_844
+00000940 d .C1_845
+00000575 d .C1_846
+00000944 d .C1_847
+0000058d d .C1_848
+00000948 d .C1_849
+000005b3 d .C1_850
+0000094c d .C1_851
+000005e7 d .C1_852
+00000950 d .C1_853
+0000060d d .C1_854
+00000627 d .C1_855
+00000954 d .C1_856
+0000062b d .C1_857
+00000958 d .C1_858
+0000064f d .C1_859
+0000095c d .C1_860
+00000674 d .C1_861
+0000068e d .C1_862
+00000960 d .C1_863
+00000690 d .C1_864
+00000964 d .C1_865
+000006b2 d .C1_866
+00000968 d .C1_867
+000006d5 d .C1_868
+0000096c d .C1_869
+000006fa d .C1_870
+00000701 d .C1_871
+00000970 d .C1_872
+00000708 d .C1_873
+00000728 d .C1_874
+00000974 d .C1_875
+00000743 d .C1_876
+00000765 d .C1_877
+00000978 d .C1_878
+00000777 d .C1_879
+0000097c d .C1_880
+00000780 d .C1_881
+00000988 d .C1_882
+000007a1 d .C1_883
+000007b4 d .C1_884
+00000990 d .C1_885
+000007b6 d .C1_886
+000007c1 d .C1_887
+00000994 d .C1_888
+000007d5 d .C1_889
+000007db d .C1_890
+000007df d .C1_891
+00000824 d .C1_893
+000007e7 d .C1_894
+00000998 d .C1_895
+000007e8 d .C1_896
+0000099c d .C1_897
+0000080e d .C1_898
+00000812 d .C1_899
+00000814 d .C1_900
+000009a4 d .C1_901
+00000821 d .C1_902
+000009ac d .C1_906
+0000087c d .C1_907
+00000980 d .C1_918
+000009c8 d .STATICS1
+000047b6 t __phyetat0_END
+         U abort_
+00000018 C advtr_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_str_free
+         U ftn_str_malloc
+         U ftn_strcmp
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90_trim
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T phyetat0_
+00000038 C planet_
+         U soil_settings_
+000189e4 C surfdat_
+         U tabfi_
+0000006c C yomaer_
+
+physdem1.o:
+00000000 b .BSS1
+000006d8 d .C1_1001
+000006d0 d .C1_1003
+000006b8 d .C1_1006
+0000056b d .C1_1007
+00000197 d .C1_1008
+000006bc d .C1_1009
+0000019f d .C1_1010
+000001c2 d .C1_1011
+000006c0 d .C1_1012
+000001d4 d .C1_1013
+000006c4 d .C1_1014
+00000207 d .C1_1015
+000006c8 d .C1_1016
+0000023a d .C1_1017
+00000261 d .C1_1018
+0000026a d .C1_1019
+0000027e d .C1_1020
+00000287 d .C1_1021
+000002a1 d .C1_1022
+000002a9 d .C1_1023
+000002c2 d .C1_1024
+000002c6 d .C1_1025
+000002cf d .C1_1026
+000002d5 d .C1_1027
+000002f0 d .C1_1028
+000002f9 d .C1_1029
+0000030e d .C1_1030
+00000312 d .C1_1031
+00000325 d .C1_1032
+00000329 d .C1_1033
+00000343 d .C1_1034
+00000347 d .C1_1035
+0000035e d .C1_1036
+00000362 d .C1_1037
+00000379 d .C1_1038
+0000037d d .C1_1039
+00000394 d .C1_1040
+0000039a d .C1_1041
+000003a7 d .C1_1042
+000003b1 d .C1_1044
+000003c5 d .C1_1045
+000003ca d .C1_1046
+000003dd d .C1_1047
+000003e2 d .C1_1048
+000003f2 d .C1_1049
+000003f6 d .C1_1050
+00000408 d .C1_1051
+0000040a d .C1_1052
+000006f8 d .C1_1053
+0000041b d .C1_1054
+00000504 d .C1_1056
+000006fc d .C1_1057
+00000437 d .C1_1058
+00000440 d .C1_1059
+00000700 d .C1_1065
+00000441 d .C1_1066
+0000046c d .C1_1067
+00000704 d .C1_1068
+0000048c d .C1_1069
+00000708 d .C1_1070
+000004a8 d .C1_1071
+0000070c d .C1_1073
+000004d8 d .C1_1074
+00000513 d .C1_1075
+00000564 d .C1_1076
+00000710 d .C1_1077
+00000505 d .C1_1078
+0000050e d .C1_1079
+00000718 d .C1_1080
+0000051a d .C1_1081
+0000071c d .C1_1082
+00000540 d .C1_1083
+00000720 d .C1_1085
+00000728 d .C1_1086
+000005b0 d .C1_1087
+0000059f d .C1_1088
+00000730 d .C1_1089
+000005cb d .C1_1090
+00000734 d .C1_1091
+000005db d .C1_1092
+00000738 d .C1_1093
+0000065e d .C1_1094
+00000748 d .C1_283
+00000744 d .C1_285
+000006f4 d .C1_340
+00000698 d .C1_343
+00000724 d .C1_345
+0000073c d .C1_482
+000006cc d .C1_485
+000006e0 d .C1_489
+00000740 d .C1_490
+000006ec d .C1_492
+000006b4 d .C1_760
+000006e4 d .C1_766
+0000067c d .C1_829
+000006e8 d .C1_917
+00000607 d .C1_956
+00000000 d .C1_958
+00000678 d .C1_963
+0000059a d .C1_965
+000006f0 d .C1_966
+00000020 d .C1_967
+00000032 d .C1_968
+00000680 d .C1_969
+00000037 d .C1_970
+00000684 d .C1_971
+00000061 d .C1_972
+00000688 d .C1_973
+00000070 d .C1_974
+0000068c d .C1_975
+0000072c d .C1_976
+000000a4 d .C1_977
+00000690 d .C1_978
+000000b5 d .C1_979
+00000694 d .C1_980
+000000eb d .C1_981
+0000069c d .C1_982
+000000f8 d .C1_983
+000006a0 d .C1_984
+00000714 d .C1_985
+00000125 d .C1_986
+000006a4 d .C1_987
+0000013e d .C1_988
+000006a8 d .C1_989
+00000172 d .C1_990
+00000178 d .C1_991
+000006ac d .C1_992
+000006b0 d .C1_993
+00000184 d .C1_994
+000006d4 d .C1_997
+000006dc d .C1_999
+00000750 d .STATICS1
+000032c5 t __physdem1_END
+         U abort_
+00000018 C advtr_
+000000c0 C callkeys_
+00000020 C clesph0_
+00000028 C comcstfi_
+00000020 C comdissnew_
+000000d4 C comgeom_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000050 C comsoil1_
+00023284 C comsoil2_
+00000a68 C comvert_
+00000024 C control_
+0000011c C ener_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+         U lnblnk_
+0000003c C logic_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_adjustl
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+         U pgf90_trim
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_intern_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T physdem1_
+00000038 C planet_
+         U scopy_
+00000038 C serre_
+000189e4 C surfdat_
+0000006c C yomaer_
+
+profile.o:
+00000000 b .BSS1
+00000134 d .C1_283
+00000128 d .C1_285
+00000110 d .C1_287
+000000b4 d .C1_288
+00000108 d .C1_290
+00000120 d .C1_313
+000000d4 d .C1_314
+00000118 d .C1_319
+000000e8 d .C1_398
+00000000 d .C1_403
+000000f8 d .C1_404
+00000007 d .C1_405
+0000000b d .C1_406
+0000000f d .C1_408
+00000130 d .C1_409
+00000012 d .C1_411
+000000f4 d .C1_412
+00000019 d .C1_413
+000000d8 d .C1_415
+000000e0 d .C1_416
+000000dc d .C1_417
+000000ec d .C1_418
+000000fc d .C1_420
+000000e4 d .C1_421
+00000100 d .C1_422
+00000104 d .C1_423
+0000010c d .C1_425
+00000058 d .C1_426
+00000114 d .C1_428
+0000002b d .C1_429
+0000003b d .C1_430
+00000032 d .C1_431
+0000011c d .C1_435
+00000124 d .C1_438
+0000003e d .C1_441
+0000012c d .C1_443
+000000b0 d .C1_445
+000000b8 d .C1_446
+000000c0 d .C1_447
+000000c8 d .C1_449
+00000020 d .C1_450
+000000cc d .C1_451
+000000d0 d .C1_455
+000000f0 d .C1_533
+000000c4 d .C1_569
+000000bc d .C1_570
+00000138 d .STATICS1
+         U __mth_i_asinx
+         U __mth_i_expx
+         U __mth_i_sinx
+00000ca8 t __profile_END
+         U ioipsl_errioipsl_
+00000014 C ioipsl_errioipsl_12_
+         U ioipsl_getincom_
+0000002c C ioipsl_getincom_12_
+00000006 C ioipsl_getincom_13_
+000002b4 C ioipsl_getincom_4_
+00002710 C ioipsl_getincom_5_
+         U ioipsl_getincom_getinis_
+         U ioipsl_getincom_getinrs_
+         U ioipsl_stringop_
+00000078 C ioipsl_stringop_8_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_close
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+00000010 T profile_
+
+readcoord.o:
+00000000 b .BSS1
+000001cc d .C1_283
+000001c8 d .C1_285
+0000017c d .C1_309
+0000007a d .C1_316
+00000000 d .C1_317
+00000009 d .C1_319
+000000ed d .C1_320
+00000164 d .C1_322
+000001ac d .C1_323
+00000013 d .C1_325
+0000000a d .C1_326
+00000198 d .C1_328
+00000168 d .C1_331
+000001c0 d .C1_332
+000001c4 d .C1_335
+0000016c d .C1_337
+00000016 d .C1_338
+00000170 d .C1_339
+0000004a d .C1_340
+00000174 d .C1_341
+00000178 d .C1_342
+00000077 d .C1_343
+00000180 d .C1_350
+000001a0 d .C1_354
+00000184 d .C1_356
+0000007b d .C1_358
+00000188 d .C1_362
+0000018c d .C1_364
+00000190 d .C1_365
+0000007c d .C1_366
+00000194 d .C1_367
+0000019c d .C1_368
+0000007d d .C1_369
+000001a4 d .C1_370
+000001a8 d .C1_371
+000001b0 d .C1_372
+0000007e d .C1_373
+00000089 d .C1_374
+000001b4 d .C1_375
+000000aa d .C1_376
+000001b8 d .C1_377
+000000bc d .C1_378
+000001bc d .C1_379
+00000143 d .C1_380
+000001d0 d .STATICS1
+00000f4e t __readcoord_END
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U lnblnk_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_ldr
+00000010 T readcoord_
+
+readstd.o:
+00000000 b .BSS1
+000002b8 d .C1_283
+000002ac d .C1_285
+00000270 d .C1_300
+000000b0 d .C1_330
+000001ad d .C1_332
+00000204 d .C1_334
+000002b4 d .C1_335
+00000000 d .C1_336
+00000009 d .C1_339
+00000208 d .C1_341
+0000020c d .C1_344
+0000029c d .C1_345
+0000000c d .C1_346
+000002a8 d .C1_349
+00000210 d .C1_351
+00000214 d .C1_353
+0000002c d .C1_354
+00000218 d .C1_355
+00000060 d .C1_356
+0000021c d .C1_357
+00000220 d .C1_358
+00000081 d .C1_359
+00000224 d .C1_366
+00000084 d .C1_367
+0000008a d .C1_368
+0000008b d .C1_369
+00000228 d .C1_370
+0000008e d .C1_372
+000000fe d .C1_373
+0000022c d .C1_374
+0000009a d .C1_375
+00000274 d .C1_377
+000000a0 d .C1_378
+00000230 d .C1_379
+00000095 d .C1_380
+00000234 d .C1_381
+00000238 d .C1_382
+000000a4 d .C1_383
+0000023c d .C1_384
+000000ac d .C1_385
+00000240 d .C1_386
+00000244 d .C1_388
+000000b8 d .C1_389
+00000248 d .C1_390
+000000bf d .C1_391
+000000c4 d .C1_392
+0000024c d .C1_393
+000000d8 d .C1_394
+00000250 d .C1_398
+000000eb d .C1_399
+00000254 d .C1_402
+000000f4 d .C1_403
+00000258 d .C1_404
+0000025c d .C1_405
+00000260 d .C1_406
+00000264 d .C1_407
+00000268 d .C1_408
+00000288 d .C1_409
+0000026c d .C1_411
+0000027c d .C1_412
+00000278 d .C1_413
+00000280 d .C1_414
+00000284 d .C1_415
+0000028c d .C1_419
+000000ff d .C1_420
+00000290 d .C1_421
+0000012f d .C1_422
+00000294 d .C1_423
+00000157 d .C1_424
+00000298 d .C1_425
+00000183 d .C1_426
+000001a7 d .C1_427
+000002a0 d .C1_429
+000002a4 d .C1_431
+000001ab d .C1_432
+000001ac d .C1_433
+000002b0 d .C1_435
+00001cbf t __readstd_END
+         U from36_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+00000934 C lmdstdch_
+0000012c C lmdstdnu_
+         U lnblnk_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_template1v
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtr_intern_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_fmt_read
+         U pghpfio_ldr
+00000010 T readstd_
+
+readtesassim.o:
+00000000 b .BSS1
+000003d0 d .C1_283
+000003cc d .C1_285
+000003a8 d .C1_287
+000003a4 d .C1_288
+00000350 d .C1_339
+000003c0 d .C1_340
+000003c4 d .C1_341
+0000038c d .C1_356
+00000390 d .C1_372
+00000384 d .C1_731
+00000330 d .C1_733
+00000364 d .C1_734
+00000000 d .C1_735
+0000000b d .C1_738
+0000037c d .C1_739
+0000001b d .C1_740
+0000002b d .C1_742
+0000007a d .C1_743
+000002cd d .C1_744
+00000334 d .C1_746
+0000003b d .C1_747
+0000004b d .C1_750
+00000338 d .C1_753
+00000069 d .C1_754
+0000033c d .C1_755
+0000007b d .C1_756
+00000340 d .C1_757
+000000a7 d .C1_758
+00000344 d .C1_759
+000000c1 d .C1_760
+00000348 d .C1_761
+000000ef d .C1_762
+0000034c d .C1_763
+0000010c d .C1_764
+0000016d d .C1_766
+00000195 d .C1_767
+000001c5 d .C1_768
+00000141 d .C1_773
+00000354 d .C1_774
+00000147 d .C1_775
+00000358 d .C1_777
+00000171 d .C1_778
+0000035c d .C1_779
+0000019d d .C1_780
+00000360 d .C1_781
+000001ce d .C1_782
+00000380 d .C1_783
+00000368 d .C1_787
+000001f7 d .C1_788
+0000036c d .C1_789
+00000225 d .C1_790
+00000370 d .C1_791
+0000022b d .C1_792
+00000374 d .C1_793
+00000231 d .C1_794
+00000378 d .C1_795
+00000237 d .C1_796
+00000388 d .C1_798
+0000023d d .C1_799
+0000025e d .C1_800
+000003c8 d .C1_801
+00000264 d .C1_802
+00000394 d .C1_803
+0000026f d .C1_804
+00000398 d .C1_805
+0000027a d .C1_806
+0000039c d .C1_807
+0000027f d .C1_808
+000003a0 d .C1_809
+00000284 d .C1_810
+000003ac d .C1_811
+00000288 d .C1_812
+000003b0 d .C1_813
+000002bc d .C1_814
+000003b4 d .C1_815
+000002c2 d .C1_816
+000003b8 d .C1_817
+000002c7 d .C1_818
+000003bc d .C1_819
+0000032a d .C1_820
+000003d4 d .C1_822
+000003d8 d .STATICS1
+         U __mth_i_acosx
+         U __mth_i_amodx
+000021f9 t __readtesassim_END
+         U abort_
+000000c0 C callkeys_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T readtesassim_
+
+scatter.o:
+00000053 t __scatter_END
+         U pgf90_compiled
+00000010 T scatter_
+
+scopy.o:
+00000000 b .BSS1
+00000080 t __scopy_END
+         U pgf90_compiled
+00000010 T scopy_
+
+scopyi.o:
+00000000 b .BSS1
+00000080 t __scopyi_END
+         U pgf90_compiled
+00000010 T scopyi_
+
+sdot.o:
+00000000 b .BSS1
+00000000 d .C1_287
+00000091 t __sdot_END
+         U pgf90_compiled
+00000010 T sdot_
+
+soil.o:
+00000000 b .BSS1
+00000000 d .C1_288
+000006cb t __soil_END
+00000050 C comsoil1_
+00023284 C comsoil2_
+         U pgf90_compiled
+00000010 T soil_
+
+soil_settings.o:
+00000000 b .BSS1
+00000564 d .C1_1096
+0000057c d .C1_283
+00000578 d .C1_285
+00000508 d .C1_287
+000004e8 d .C1_288
+00000500 d .C1_289
+00000504 d .C1_290
+00000550 d .C1_342
+0000056c d .C1_343
+00000570 d .C1_344
+00000518 d .C1_672
+00000000 d .C1_673
+00000454 d .C1_674
+000004cc d .C1_676
+00000011 d .C1_677
+000004d0 d .C1_683
+00000043 d .C1_684
+00000075 d .C1_685
+000004d4 d .C1_686
+0000007b d .C1_687
+000000ac d .C1_688
+0000022e d .C1_690
+000004d8 d .C1_691
+00000238 d .C1_692
+000004dc d .C1_693
+000000d1 d .C1_694
+000004e0 d .C1_695
+000000fd d .C1_696
+000004e4 d .C1_699
+00000123 d .C1_700
+00000151 d .C1_703
+000004f0 d .C1_704
+0000015a d .C1_705
+000004f4 d .C1_706
+00000185 d .C1_707
+000004f8 d .C1_708
+000004fc d .C1_709
+0000050c d .C1_710
+000001b5 d .C1_711
+00000574 d .C1_712
+00000510 d .C1_713
+000001d7 d .C1_714
+00000514 d .C1_715
+000001fd d .C1_716
+0000051c d .C1_717
+00000520 d .C1_718
+00000264 d .C1_719
+00000524 d .C1_721
+000002fa d .C1_722
+00000528 d .C1_723
+000002a1 d .C1_724
+0000052c d .C1_726
+00000387 d .C1_727
+000002ec d .C1_728
+00000530 d .C1_729
+00000534 d .C1_730
+0000032b d .C1_731
+00000538 d .C1_732
+00000330 d .C1_733
+0000053c d .C1_734
+00000357 d .C1_735
+00000540 d .C1_737
+000003ab d .C1_738
+00000544 d .C1_739
+000003b4 d .C1_740
+00000548 d .C1_741
+0000054c d .C1_746
+000003e0 d .C1_747
+00000554 d .C1_748
+00000558 d .C1_749
+00000414 d .C1_750
+0000055c d .C1_751
+00000432 d .C1_752
+00000568 d .C1_755
+000004b0 d .C1_756
+00000560 d .C1_764
+000004ec d .C1_961
+00000580 d .STATICS1
+         U __mth_i_rpowix
+         U __mth_i_rpowrx
+00002636 t __soil_settings_END
+         U abort_
+00000050 C comsoil1_
+00023284 C comsoil2_
+         U interp_line_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_alloc
+         U pgf90_allocated
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T soil_settings_
+
+solang.o:
+00000000 d .C1_287
+000000fd t __solang_END
+         U pgf90_compiled
+00000010 T solang_
+
+solarlong.o:
+00000000 b .BSS1
+00000034 d .C1_287
+00000030 d .C1_288
+0000002c d .C1_290
+00000010 d .C1_331
+00000014 d .C1_333
+00000018 d .C1_334
+0000001c d .C1_335
+00000020 d .C1_336
+00000024 d .C1_337
+00000028 d .C1_339
+00000000 d .C1_383
+         U __mth_i_asinx
+         U __mth_i_atanx
+         U __mth_i_nintx
+         U __mth_i_sincosx
+         U __mth_i_sinx
+         U __mth_i_tanx
+000002c8 t __solarlong_END
+00000028 C comcstfi_
+         U iniorbit_
+         U pgf90_compiled
+00000038 C planet_
+00000010 T solarlong_
+
+ssum.o:
+00000000 b .BSS1
+00000000 d .C1_287
+0000006a t __ssum_END
+         U pgf90_compiled
+00000010 T ssum_
+
+suaer.o:
+00000000 b .BSS1
+0000046c d .C1_283
+00000468 d .C1_285
+00000454 d .C1_288
+000003f8 d .C1_346
+000003c8 d .C1_379
+0000041c d .C1_460
+00000000 d .C1_467
+00000013 d .C1_468
+0000002a d .C1_471
+00000040 d .C1_472
+0000031d d .C1_476
+00000374 d .C1_478
+000001a8 d .C1_480
+00000378 d .C1_483
+00000460 d .C1_484
+00000055 d .C1_486
+00000464 d .C1_489
+0000037c d .C1_491
+00000065 d .C1_492
+00000380 d .C1_493
+00000076 d .C1_494
+00000384 d .C1_495
+000000a2 d .C1_496
+00000388 d .C1_497
+000000ba d .C1_498
+000000c0 d .C1_499
+0000038c d .C1_500
+00000458 d .C1_501
+000000e0 d .C1_502
+00000390 d .C1_503
+000000fb d .C1_504
+00000116 d .C1_505
+00000394 d .C1_506
+0000012e d .C1_507
+00000398 d .C1_508
+0000015a d .C1_509
+0000039c d .C1_510
+00000184 d .C1_511
+000003a0 d .C1_513
+000001a9 d .C1_514
+000003a4 d .C1_518
+000001bf d .C1_522
+000001c0 d .C1_523
+000003a8 d .C1_524
+000003ac d .C1_526
+0000043c d .C1_527
+000003b0 d .C1_529
+000003b4 d .C1_531
+000001b2 d .C1_532
+000001cc d .C1_533
+000003b8 d .C1_540
+000003bc d .C1_541
+000003c0 d .C1_542
+000003c4 d .C1_545
+000003cc d .C1_547
+000003d0 d .C1_548
+000003d4 d .C1_549
+000003d8 d .C1_552
+000003dc d .C1_553
+000003e0 d .C1_554
+000003e4 d .C1_556
+000003e8 d .C1_557
+000003ec d .C1_558
+000003f0 d .C1_559
+000001c1 d .C1_560
+000003f4 d .C1_561
+000003fc d .C1_565
+000001f3 d .C1_566
+00000400 d .C1_567
+0000020b d .C1_568
+00000404 d .C1_569
+0000021d d .C1_570
+00000408 d .C1_571
+0000022d d .C1_572
+0000040c d .C1_573
+000002db d .C1_574
+00000410 d .C1_575
+00000414 d .C1_576
+0000023c d .C1_577
+00000262 d .C1_578
+00000418 d .C1_579
+00000244 d .C1_580
+00000420 d .C1_583
+00000250 d .C1_584
+00000424 d .C1_585
+00000257 d .C1_586
+00000428 d .C1_587
+00000266 d .C1_588
+00000279 d .C1_589
+0000042c d .C1_590
+0000027b d .C1_591
+00000430 d .C1_592
+000002cc d .C1_593
+00000434 d .C1_594
+00000289 d .C1_595
+00000438 d .C1_596
+0000029c d .C1_597
+00000440 d .C1_598
+000002b7 d .C1_599
+00000444 d .C1_600
+00000448 d .C1_601
+0000044c d .C1_602
+00000450 d .C1_603
+000002fe d .C1_604
+0000045c d .C1_605
+00000373 d .C1_606
+00000470 d .STATICS1
+000035f3 t __suaer_END
+         U abort_
+         U aerave_
+000000c0 C callkeys_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U pgf90_alloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90_template1v
+         U pgf90io_backspace
+         U pgf90io_close
+         U pgf90io_inquire
+         U pgf90io_ldr
+         U pgf90io_ldr_a
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_ldr
+00000010 T suaer_
+0000006c C yomaer_
+         U zerophys_
+
+sugwd.o:
+00000000 b .BSS1
+00000088 d .C1_283
+00000084 d .C1_285
+000000a0 d .C1_287
+00000098 d .C1_288
+00000070 d .C1_290
+00000064 d .C1_317
+00000068 d .C1_318
+0000006c d .C1_319
+00000000 d .C1_320
+00000074 d .C1_322
+00000078 d .C1_323
+00000054 d .C1_325
+0000007c d .C1_329
+00000080 d .C1_330
+0000008c d .C1_332
+00000090 d .C1_333
+00000094 d .C1_334
+0000009c d .C1_335
+000000a4 d .C1_336
+000000a8 d .C1_337
+000001e6 t __sugwd_END
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T sugwd_
+00000034 C yoegwd_
+
+sulw.o:
+00000015 t __sulw_END
+000000c0 C callkeys_
+06b3a000 C ksicom_
+         U pgf90_compiled
+00000010 T sulw_
+00000000 D yomlw_
+
+surfini.o:
+00000000 b .BSS1
+000000b0 d .C1_283
+000000ac d .C1_285
+00000094 d .C1_287
+0000001a d .C1_419
+0000008c d .C1_421
+000000a0 d .C1_422
+00000000 d .C1_425
+000000a4 d .C1_427
+000000a8 d .C1_428
+00000090 d .C1_430
+00000070 d .C1_431
+00000098 d .C1_432
+0000009c d .C1_433
+0000046e t __surfini_END
+000000c0 C callkeys_
+         U ismax_
+         U ismin_
+         U pgf90_compiled
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000189e4 C surfdat_
+00000010 T surfini_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+
+swmain.o:
+00000000 b .BSS1
+00000000 d .C1_287
+0000000c d .C1_288
+00000004 d .C1_471
+00000008 d .C1_473
+00000458 t __swmain_END
+000000c0 C callkeys_
+06b3a000 C ksicom_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T swmain_
+         U swr_fouquart_
+         U swr_toon_
+0000006c C yomaer_
+000000e0 C yomlw_
+
+swr_fouquart.o:
+00000000 b .BSS1
+01518038 b .BSS2
+00000000 d .C1_287
+00000010 d .C1_288
+00000008 d .C1_290
+00000004 d .C1_507
+0000000c d .C1_508
+00000020 d .C2_288
+00000040 d .C2_291
+00000048 d .C2_292
+00000028 d .C2_381
+00000038 d .C2_382
+00000030 d .C2_383
+00000018 d .STATICS1
+00001815 t __dedd_END
+         U __mth_i_dexpx
+         U __mth_i_expx
+00001229 t __swr_fouquart_END
+000000c0 C callkeys_
+         U cvmgt_
+00001230 T dedd_
+06b3a000 C ksicom_
+         U pgf90_compiled
+00000010 T swr_fouquart_
+         U swrayleigh_
+0000006c C yomaer_
+000000e0 C yomlw_
+
+swr_toon.o:
+00000000 b .BSS1
+0027c550 b .BSS2
+00283cd8 b .BSS3
+00285c48 b .BSS4
+00000004 d .C1_287
+00000008 d .C1_288
+00000000 d .C1_420
+00000060 d .C2_291
+00000058 d .C2_292
+00000040 d .C2_294
+00000018 d .C2_337
+00000028 d .C2_338
+00000020 d .C2_339
+00000030 d .C2_340
+00000048 d .C2_342
+00000050 d .C2_343
+00000038 d .C2_417
+00000088 d .C3_291
+00000080 d .C3_292
+00000090 d .C3_328
+00000070 d .C3_421
+00000098 d .C4_292
+00000010 d .STATICS1
+000012a6 t __dsolver_END
+000013f8 t __dtridgl_END
+00000ea6 t __gfluxv_END
+         U __mth_i_dexpx
+00000846 t __swr_toon_END
+000000c0 C callkeys_
+         U cvmgt_
+00000eb0 T dsolver_
+000012b0 T dtridgl_
+00000850 T gfluxv_
+06b3a000 C ksicom_
+         U pgf90_auto_alloc
+         U pgf90_auto_dealloc
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+00000010 T swr_toon_
+         U swrayleigh_
+0000006c C yomaer_
+000000e0 C yomlw_
+
+swrayleigh.o:
+00000000 d .STATICS1
+00000092 t __swrayleigh_END
+00000028 C comcstfi_
+         U pgf90_compiled
+00000010 T swrayleigh_
+
+tabfi.o:
+00000000 b .BSS1
+00000661 d .C1_1000
+00000db8 d .C1_1001
+00000dbc d .C1_1002
+0000067b d .C1_1003
+00000dc0 d .C1_1004
+00000dc4 d .C1_1006
+00000dc8 d .C1_1007
+00000dcc d .C1_1008
+0000069c d .C1_1009
+000006b6 d .C1_1010
+00000dd0 d .C1_1011
+00000dd4 d .C1_1012
+00000dd8 d .C1_1014
+00000ddc d .C1_1015
+00000de0 d .C1_1016
+000006bc d .C1_1017
+000006d0 d .C1_1018
+00000de4 d .C1_1019
+00000de8 d .C1_1020
+000006d8 d .C1_1021
+00000dec d .C1_1022
+00000df0 d .C1_1024
+00000df4 d .C1_1025
+00000df8 d .C1_1026
+00000700 d .C1_1027
+00000716 d .C1_1028
+00000dfc d .C1_1029
+00000e00 d .C1_1030
+0000071e d .C1_1031
+00000e04 d .C1_1032
+00000e08 d .C1_1034
+00000e0c d .C1_1035
+00000e10 d .C1_1036
+00000744 d .C1_1037
+0000075a d .C1_1038
+00000e14 d .C1_1039
+00000e18 d .C1_1040
+00000762 d .C1_1041
+00000e1c d .C1_1042
+00000e20 d .C1_1044
+00000e24 d .C1_1045
+00000e28 d .C1_1046
+0000078d d .C1_1047
+000007a3 d .C1_1048
+00000e2c d .C1_1049
+00000e30 d .C1_1050
+000007aa d .C1_1051
+00000e34 d .C1_1052
+00000e38 d .C1_1054
+00000e3c d .C1_1055
+00000e40 d .C1_1056
+000007d3 d .C1_1057
+000007e8 d .C1_1058
+00000e44 d .C1_1059
+00000e48 d .C1_1060
+00000e4c d .C1_1062
+00000e54 d .C1_1063
+00000e58 d .C1_1064
+0000080d d .C1_1065
+00000e5c d .C1_1066
+00000e60 d .C1_1067
+00000822 d .C1_1068
+00000e64 d .C1_1069
+00000e68 d .C1_1070
+00000e70 d .C1_1071
+00000e74 d .C1_1072
+00000e78 d .C1_1073
+00000e7c d .C1_1074
+00000e80 d .C1_1075
+00000e84 d .C1_1076
+00000e88 d .C1_1077
+00000e8c d .C1_1078
+00000e90 d .C1_1079
+00000e94 d .C1_1080
+00000e98 d .C1_1081
+00000e9c d .C1_1082
+00000ea0 d .C1_1083
+00000ea4 d .C1_1084
+00000ea8 d .C1_1085
+00000eac d .C1_1086
+00000eb0 d .C1_1087
+00000eb4 d .C1_1088
+00000eb8 d .C1_1089
+00000ebc d .C1_1090
+00000ec0 d .C1_1091
+00000ec4 d .C1_1092
+00000ec8 d .C1_1093
+00000ecc d .C1_1094
+00000ed0 d .C1_1095
+00000ed4 d .C1_1096
+00000ed8 d .C1_1097
+00000edc d .C1_1098
+00000ee0 d .C1_1099
+00000ee4 d .C1_1100
+00000eec d .C1_1101
+00000ab0 d .C1_1102
+00000ef0 d .C1_1103
+00000ad9 d .C1_1104
+00000ef4 d .C1_1105
+00000b3d d .C1_1106
+00000f08 d .C1_283
+00000f04 d .C1_285
+00000ee8 d .C1_287
+00000b58 d .C1_288
+00000bb4 d .C1_315
+00000ba8 d .C1_394
+00000e50 d .C1_395
+00000ef8 d .C1_396
+00000efc d .C1_400
+00000c24 d .C1_416
+00000c28 d .C1_432
+00000ba4 d .C1_705
+00000b50 d .C1_711
+00000b54 d .C1_712
+00000b5c d .C1_713
+00000b60 d .C1_714
+00000b64 d .C1_715
+00000b68 d .C1_716
+00000b6c d .C1_717
+00000b70 d .C1_718
+00000b74 d .C1_719
+00000b78 d .C1_720
+00000b7c d .C1_721
+00000b80 d .C1_722
+00000b84 d .C1_723
+00000b88 d .C1_724
+00000b8c d .C1_725
+00000b90 d .C1_729
+00000b94 d .C1_730
+00000000 d .C1_731
+00000ae9 d .C1_732
+00000b98 d .C1_734
+00000008 d .C1_737
+00000b9c d .C1_741
+0000002d d .C1_742
+00000ba0 d .C1_743
+00000053 d .C1_744
+00000f00 d .C1_745
+00000e6c d .C1_747
+00000bac d .C1_748
+00000063 d .C1_749
+00000bb0 d .C1_750
+00000ccc d .C1_751
+00000bb8 d .C1_752
+00000092 d .C1_754
+00000bbc d .C1_764
+00000854 d .C1_765
+00000bc0 d .C1_766
+000000a3 d .C1_767
+00000bc4 d .C1_768
+00000bc8 d .C1_769
+00000889 d .C1_770
+00000bcc d .C1_774
+0000089c d .C1_775
+00000bd0 d .C1_776
+000008af d .C1_777
+00000bd4 d .C1_778
+000008c2 d .C1_779
+00000bd8 d .C1_780
+000008d5 d .C1_781
+00000bdc d .C1_782
+000008e8 d .C1_783
+00000be0 d .C1_784
+000008fb d .C1_785
+00000be4 d .C1_786
+0000090e d .C1_787
+00000be8 d .C1_788
+00000921 d .C1_789
+00000bec d .C1_790
+00000934 d .C1_791
+00000bf0 d .C1_792
+00000947 d .C1_793
+00000bf4 d .C1_794
+0000095a d .C1_795
+00000bf8 d .C1_796
+0000096d d .C1_797
+00000bfc d .C1_798
+00000980 d .C1_799
+00000c00 d .C1_800
+00000993 d .C1_801
+00000c04 d .C1_802
+000009a6 d .C1_803
+00000c08 d .C1_804
+000009b9 d .C1_805
+00000c0c d .C1_806
+000009cc d .C1_807
+00000c10 d .C1_808
+000009df d .C1_809
+00000c14 d .C1_810
+000009f2 d .C1_811
+00000c18 d .C1_812
+00000a05 d .C1_813
+00000c1c d .C1_814
+00000a18 d .C1_815
+00000c20 d .C1_816
+00000a2b d .C1_817
+00000a3e d .C1_818
+00000a51 d .C1_819
+00000c2c d .C1_820
+00000a64 d .C1_821
+00000c30 d .C1_822
+00000a77 d .C1_823
+00000c34 d .C1_824
+00000a8a d .C1_825
+00000c38 d .C1_826
+00000a9d d .C1_827
+00000c3c d .C1_828
+00000c40 d .C1_829
+000000d6 d .C1_830
+00000c44 d .C1_831
+00000c48 d .C1_832
+000000ec d .C1_833
+00000c4c d .C1_834
+0000010a d .C1_835
+00000c50 d .C1_836
+00000128 d .C1_837
+00000c54 d .C1_838
+00000c58 d .C1_839
+00000144 d .C1_840
+00000c5c d .C1_841
+00000173 d .C1_842
+00000c60 d .C1_843
+000001a0 d .C1_844
+00000c64 d .C1_845
+000001cc d .C1_846
+00000c68 d .C1_847
+000001f6 d .C1_848
+00000c6c d .C1_849
+0000021e d .C1_850
+00000c70 d .C1_851
+0000024c d .C1_852
+00000c74 d .C1_853
+00000276 d .C1_854
+00000c78 d .C1_855
+000002a9 d .C1_856
+000002d3 d .C1_857
+00000c7c d .C1_858
+000002e0 d .C1_859
+0000030e d .C1_860
+00000c80 d .C1_861
+00000315 d .C1_862
+00000c84 d .C1_863
+00000349 d .C1_864
+00000c88 d .C1_865
+00000376 d .C1_866
+00000c8c d .C1_867
+000003ab d .C1_868
+00000c90 d .C1_869
+000003d8 d .C1_870
+00000c94 d .C1_871
+00000405 d .C1_873
+00000c98 d .C1_874
+00000c9c d .C1_875
+00000ca0 d .C1_876
+0000040a d .C1_877
+00000ca4 d .C1_878
+0000041e d .C1_879
+00000ca8 d .C1_880
+00000cac d .C1_881
+0000043b d .C1_882
+000004b3 d .C1_887
+00000cb0 d .C1_889
+00000cb4 d .C1_890
+00000440 d .C1_891
+00000443 d .C1_892
+00000cb8 d .C1_893
+000007ef d .C1_894
+00000cbc d .C1_895
+000007fd d .C1_896
+00000cc0 d .C1_898
+00000cc4 d .C1_902
+00000cc8 d .C1_903
+0000044a d .C1_904
+0000045e d .C1_906
+00000cd0 d .C1_907
+00000cd4 d .C1_908
+00000cd8 d .C1_910
+00000cdc d .C1_911
+00000ce0 d .C1_912
+00000460 d .C1_913
+00000470 d .C1_914
+00000ce4 d .C1_915
+00000ce8 d .C1_916
+00000cec d .C1_918
+00000cf0 d .C1_919
+00000cf4 d .C1_920
+00000479 d .C1_921
+00000490 d .C1_922
+00000cf8 d .C1_923
+00000cfc d .C1_924
+00000d00 d .C1_926
+00000d04 d .C1_927
+00000d08 d .C1_928
+00000497 d .C1_929
+000004ac d .C1_930
+00000d0c d .C1_931
+00000d10 d .C1_932
+00000d14 d .C1_934
+00000d18 d .C1_935
+00000d1c d .C1_936
+000004b4 d .C1_937
+000004c9 d .C1_938
+00000d20 d .C1_939
+000004d0 d .C1_940
+00000d24 d .C1_941
+00000d28 d .C1_943
+00000d2c d .C1_944
+00000d30 d .C1_945
+000004ef d .C1_946
+00000d34 d .C1_947
+00000d38 d .C1_948
+00000507 d .C1_949
+00000d3c d .C1_950
+00000d40 d .C1_952
+00000d44 d .C1_953
+00000d48 d .C1_954
+00000526 d .C1_955
+0000053e d .C1_956
+00000d4c d .C1_957
+00000546 d .C1_958
+00000d50 d .C1_959
+00000d54 d .C1_961
+00000d58 d .C1_962
+00000d5c d .C1_963
+00000566 d .C1_964
+00000d60 d .C1_965
+00000d64 d .C1_966
+0000057f d .C1_967
+00000d68 d .C1_968
+00000d6c d .C1_970
+00000d70 d .C1_971
+00000d74 d .C1_972
+0000059f d .C1_973
+000005b8 d .C1_974
+00000d78 d .C1_975
+000005c1 d .C1_976
+00000d7c d .C1_977
+00000d80 d .C1_979
+00000d84 d .C1_980
+00000d88 d .C1_981
+000005e2 d .C1_982
+00000d8c d .C1_983
+00000d90 d .C1_984
+000005fc d .C1_985
+00000d94 d .C1_986
+00000d98 d .C1_988
+00000d9c d .C1_989
+00000da0 d .C1_990
+0000061d d .C1_991
+00000637 d .C1_992
+00000da4 d .C1_993
+00000640 d .C1_994
+00000da8 d .C1_995
+00000dac d .C1_997
+00000db0 d .C1_998
+00000db4 d .C1_999
+00000f10 d .STATICS1
+         U __mth_i_asinx
+         U __mth_i_nintx
+00009900 t __tabfi_END
+         U abort_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+00000050 C comsoil1_
+00023284 C comsoil2_
+         U ftn_strcmp
+         U lnblnk_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_read
+         U pgf90io_fmt_write
+         U pgf90io_fmtr_end
+         U pgf90io_fmtr_init
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldr
+         U pgf90io_ldr_end
+         U pgf90io_ldr_init
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000038 C planet_
+000189e4 C surfdat_
+00000010 T tabfi_
+0000006c C yomaer_
+
+thermosphere.o:
+00000000 b .BSS1
+00000000 d .C1_594
+00000008 d .STATICS1
+0000030e t __thermosphere_END
+000000c0 C callkeys_
+00661074 C chimiedata_
+00000028 C comcstfi_
+0000e104 C comdiurn_
+0034bc00 C conc_
+         U conduction_
+         U euvheat_
+00000294 C flujoctes_
+00001ab8 C fotoquimica_
+00067c50 C loss_
+         U moldiff_
+         U molvis_
+         U pgf90_compiled
+00000294 C phdisef_
+00067c50 C prod_
+00000010 T thermosphere_
+00055e30 C uv_
+00004830 C vida_
+         U zerophys_
+
+to36.o:
+00000000 b .BSS1
+00000114 d .C1_283
+00000110 d .C1_285
+000000d4 d .C1_308
+000000cc d .C1_309
+00000046 d .C1_329
+000000c8 d .C1_331
+00000108 d .C1_332
+00000000 d .C1_335
+0000010c d .C1_337
+000000d8 d .C1_338
+000000d0 d .C1_341
+0000001a d .C1_342
+000000dc d .C1_343
+000000e4 d .C1_344
+000000e0 d .C1_345
+000000e8 d .C1_346
+0000002e d .C1_347
+00000031 d .C1_348
+000000ec d .C1_354
+000000f0 d .C1_355
+000000f4 d .C1_358
+000000f8 d .C1_359
+000000fc d .C1_361
+00000100 d .C1_362
+00000104 d .C1_364
+00000097 d .C1_365
+00000118 d .STATICS1
+         U __mth_i_nintx
+00000948 t __to36_END
+00000024 C elbat1_
+00000a20 C elbat2_
+000222c0 C elbat3_
+         U ftn_str_copy
+         U ini36_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T to36_
+
+updatereffrad.o:
+00000000 b .BSS1
+00000008 d .C1_288
+00000010 d .C1_435
+0000000c d .C1_437
+00000000 d .C1_439
+00000014 d .C1_442
+00000018 d .C1_443
+00000004 d .C1_499
+         U __mth_i_alogx
+         U __mth_i_tanhx
+00000213 t __updatereffrad_END
+000000c0 C callkeys_
+         U pgf90_compiled
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00000010 T updatereffrad_
+
+vdif_cd.o:
+00000000 d .C1_288
+00000008 d .STATICS1
+         U __mth_i_alogx
+00000095 t __vdif_cd_END
+         U pgf90_compiled
+00000010 T vdif_cd_
+
+vdif_kc.o:
+00000000 b .BSS1
+0000001c d .C1_287
+00000034 d .C1_288
+00000004 d .C1_378
+00000020 d .C1_380
+00000024 d .C1_381
+00000010 d .C1_382
+00000018 d .C1_384
+0000002c d .C1_385
+00000028 d .C1_386
+0000003c d .C1_387
+00000038 d .C1_388
+00000030 d .C1_389
+00000000 d .C1_391
+0000000c d .C1_394
+00000014 d .C1_396
+00000008 d .C1_576
+         U __mth_i_rpowrx
+00001022 t __vdif_kc_END
+         U pgf90_compiled
+00000010 T vdif_kc_
+
+vdifc.o:
+00000000 b .BSS1
+00000274 d .C1_283
+00000270 d .C1_285
+00000248 d .C1_287
+0000024c d .C1_288
+00000244 d .C1_337
+00000192 d .C1_514
+000001f0 d .C1_516
+00000268 d .C1_517
+00000000 d .C1_520
+00000264 d .C1_522
+000001f4 d .C1_524
+0000000f d .C1_525
+000001f8 d .C1_526
+00000027 d .C1_527
+00000200 d .C1_528
+000001fc d .C1_529
+0000002f d .C1_530
+00000204 d .C1_532
+00000039 d .C1_533
+00000050 d .C1_534
+0000026c d .C1_535
+00000208 d .C1_536
+00000057 d .C1_537
+0000020c d .C1_539
+00000210 d .C1_540
+0000006c d .C1_541
+00000214 d .C1_542
+0000009c d .C1_543
+00000220 d .C1_546
+00000224 d .C1_547
+00000218 d .C1_550
+000000a4 d .C1_551
+0000021c d .C1_552
+000000c5 d .C1_553
+00000228 d .C1_557
+0000022c d .C1_558
+000000cd d .C1_559
+00000230 d .C1_560
+000000f9 d .C1_561
+00000234 d .C1_562
+00000238 d .C1_563
+00000122 d .C1_564
+0000023c d .C1_565
+00000240 d .C1_568
+00000250 d .C1_571
+0000014f d .C1_572
+00000254 d .C1_573
+00000156 d .C1_574
+00000258 d .C1_575
+0000016a d .C1_576
+00000174 d .C1_577
+0000017c d .C1_578
+00000187 d .C1_579
+0000018b d .C1_580
+0000025c d .C1_581
+00000260 d .C1_582
+000001e6 d .C1_583
+00000278 d .STATICS1
+         U __mth_i_rpowrx
+00002e7d t __vdifc_END
+000000c0 C callkeys_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U dustlift_
+         U multipl_
+00003840 C permcap_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+         U scopy_
+         U ssum_
+000189e4 C surfdat_
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+         U vdif_cd_
+         U vdif_kc_
+00000010 T vdifc_
+         U watersat_
+         U zerophys_
+
+vlz_fi.o:
+00000000 b .BSS1
+000000a8 d .C1_283
+000000a4 d .C1_285
+00000094 d .C1_287
+0000008c d .C1_288
+00000090 d .C1_290
+00000010 d .C1_338
+00000098 d .C1_340
+0000009c d .C1_341
+00000065 d .C1_342
+000000a0 d .C1_346
+00000000 d .C1_483
+00000931 t __vlz_fi_END
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T vlz_fi_
+
+watercloud.o:
+00000000 b .BSS1
+00000134 d .C1_283
+00000130 d .C1_285
+00000190 d .C1_287
+00000168 d .C1_288
+00000198 d .C1_292
+0000010c d .C1_326
+0000015c d .C1_451
+0000017c d .C1_463
+00000090 d .C1_479
+000000fc d .C1_481
+00000124 d .C1_482
+00000000 d .C1_485
+00000128 d .C1_487
+00000100 d .C1_489
+00000014 d .C1_490
+00000104 d .C1_491
+0000002c d .C1_492
+0000012c d .C1_493
+00000108 d .C1_494
+00000034 d .C1_495
+00000110 d .C1_497
+0000003e d .C1_498
+00000114 d .C1_499
+0000005e d .C1_501
+00000061 d .C1_502
+00000067 d .C1_504
+00000118 d .C1_505
+0000006b d .C1_506
+0000011c d .C1_507
+0000007e d .C1_508
+00000120 d .C1_509
+000000e9 d .C1_510
+00000138 d .C1_512
+00000140 d .C1_513
+00000144 d .C1_515
+00000174 d .C1_516
+0000014c d .C1_518
+00000154 d .C1_520
+00000170 d .C1_523
+00000160 d .C1_526
+000001a0 d .C1_529
+0000016c d .C1_530
+00000184 d .C1_532
+00000180 d .C1_533
+00000188 d .C1_534
+0000018c d .C1_535
+00000194 d .C1_536
+0000013c d .C1_715
+00000178 d .C1_726
+00000148 d .C1_729
+00000150 d .C1_731
+00000158 d .C1_732
+00000164 d .C1_749
+000001a8 d .STATICS1
+         U __mth_i_expx
+000013b9 t __watercloud_END
+000000c0 C callkeys_
+         U cbrt_
+00000028 C comcstfi_
+0000a8c0 C comgeomfi1_
+00000004 C comgeomfi2_
+         U ftn_str_copy
+         U ftn_strcmp
+         U growthrate_
+         U pgf90_compiled
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+0000004c C tracer2_
+00000014 C tracer3_
+00003870 C tracer_
+00000010 T watercloud_
+         U watersat_
+         U zerophys_
+
+watersat.o:
+00000000 b .BSS1
+00000004 d .C1_307
+00000000 d .C1_308
+00000008 d .C1_309
+0000000c d .C1_310
+00000010 d .C1_311
+00000014 d .C1_312
+00000018 d .C1_313
+00000020 d .STATICS1
+         U __mth_i_alog10x
+         U __mth_i_rpowrx
+000000da t __watersat_END
+         U pgf90_compiled
+00000010 T watersat_
+
+wheneq.o:
+00000000 b .BSS1
+0000007e t __wheneq_END
+         U pgf90_compiled
+00000010 T wheneq_
+
+writediagfi.o:
+00000000 b .BSS1
+00000264 d .C1_283
+00000260 d .C1_285
+000001f8 d .C1_287
+00000230 d .C1_331
+00000218 d .C1_332
+000001e4 d .C1_335
+000001e8 d .C1_336
+000001f0 d .C1_337
+00000254 d .C1_437
+00000258 d .C1_438
+00000220 d .C1_452
+00000224 d .C1_468
+00000009 d .C1_736
+00000000 d .C1_744
+00000184 d .C1_746
+00000013 d .C1_749
+00000029 d .C1_754
+000001ec d .C1_755
+0000004d d .C1_756
+0000025c d .C1_757
+0000011e d .C1_759
+0000006e d .C1_761
+00000077 d .C1_762
+000001f4 d .C1_763
+0000007c d .C1_764
+000001fc d .C1_767
+00000099 d .C1_768
+00000200 d .C1_769
+000000bf d .C1_770
+00000204 d .C1_771
+000001de d .C1_772
+00000208 d .C1_773
+000000ce d .C1_774
+0000020c d .C1_775
+0000010d d .C1_776
+00000116 d .C1_777
+000000e1 d .C1_778
+00000210 d .C1_779
+00000122 d .C1_780
+00000214 d .C1_781
+0000013c d .C1_782
+0000021c d .C1_784
+000000e9 d .C1_785
+00000179 d .C1_786
+00000228 d .C1_788
+0000022c d .C1_789
+00000234 d .C1_790
+00000156 d .C1_791
+00000238 d .C1_792
+0000023c d .C1_793
+00000240 d .C1_794
+00000244 d .C1_795
+00000248 d .C1_796
+0000024c d .C1_797
+00000250 d .C1_798
+00000268 d .STATICS1
+000019ae t __writediagfi_END
+000000d4 C comgeom_
+00000a68 C comvert_
+00000024 C control_
+         U def_var_
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+         U gr_fi_dyn_
+         U iniwrite_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90_lentrim
+         U pgf90_stop
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+000189e4 C surfdat_
+00000014 C temps_
+00000078 C titre_
+00000010 T writediagfi_
+
+writediagsoil.o:
+00000000 b .BSS1
+00000200 d .C1_283
+000001fc d .C1_285
+000001dc d .C1_331
+000001cc d .C1_332
+000001ac d .C1_333
+000001f0 d .C1_373
+000001f4 d .C1_374
+000001b0 d .C1_442
+000001b4 d .C1_443
+00000000 d .C1_651
+00000116 d .C1_662
+0000000a d .C1_664
+00000022 d .C1_669
+00000047 d .C1_670
+000001b8 d .C1_671
+000001bc d .C1_673
+00000068 d .C1_674
+000000dc d .C1_676
+000001c0 d .C1_677
+00000093 d .C1_678
+000000cb d .C1_679
+000000d4 d .C1_680
+000000c6 d .C1_681
+000001c4 d .C1_682
+000000e0 d .C1_683
+000001c8 d .C1_684
+000000f5 d .C1_685
+000001d0 d .C1_687
+00000174 d .C1_688
+00000199 d .C1_689
+000001a2 d .C1_690
+000001f8 d .C1_691
+000001d4 d .C1_693
+000001d8 d .C1_694
+000001e0 d .C1_695
+000001e4 d .C1_696
+000001e8 d .C1_697
+000001ec d .C1_698
+00000208 d .STATICS1
+000019bb t __writediagsoil_END
+00000050 C comsoil1_
+00023284 C comsoil2_
+00000024 C control_
+         U def_var_
+         U ftn_str_copy
+         U ftn_str_free
+         U ftn_str_malloc
+         U ftn_strcmp
+         U iniwritesoil_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_lentrim
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000010 T writediagsoil_
+
+writeg1d.o:
+00000000 b .BSS1
+00000fb0 b .BSS2
+0000011c d .C1_283
+00000118 d .C1_285
+0000010c d .C1_304
+0000008a d .C1_330
+000000e4 d .C1_332
+00000006 d .C1_333
+00000100 d .C1_334
+00000000 d .C1_335
+000000e8 d .C1_336
+000000ec d .C1_341
+00000011 d .C1_343
+00000104 d .C1_345
+000000f0 d .C1_347
+00000114 d .C1_348
+00000032 d .C1_349
+000000f4 d .C1_352
+0000004d d .C1_353
+000000f8 d .C1_354
+00000078 d .C1_355
+00000108 d .C1_356
+000000fc d .C1_357
+0000007d d .C1_358
+00000110 d .C1_362
+000002fc d .C2_283
+000002f4 d .C2_285
+000002d4 d .C2_290
+00000243 d .C2_337
+0000029c d .C2_339
+000002a0 d .C2_340
+00000120 d .C2_343
+000002f0 d .C2_345
+000002a4 d .C2_347
+000002a8 d .C2_349
+00000153 d .C2_350
+000002ac d .C2_352
+000002b0 d .C2_354
+0000015c d .C2_355
+0000016a d .C2_356
+0000016e d .C2_359
+000002b4 d .C2_362
+0000016f d .C2_363
+0000017a d .C2_364
+00000180 d .C2_365
+000002b8 d .C2_366
+00000186 d .C2_367
+0000018b d .C2_368
+000002bc d .C2_369
+00000196 d .C2_370
+000001a1 d .C2_371
+000001a7 d .C2_372
+000002c0 d .C2_373
+000001c5 d .C2_374
+000001b0 d .C2_375
+000001ba d .C2_376
+000002e4 d .C2_377
+000002c4 d .C2_378
+000001b5 d .C2_379
+000002c8 d .C2_380
+000001d0 d .C2_381
+000001d5 d .C2_382
+000002cc d .C2_383
+000001dc d .C2_384
+000002d0 d .C2_386
+000002e8 d .C2_387
+000002d8 d .C2_388
+000001e9 d .C2_389
+000001fe d .C2_390
+00000203 d .C2_391
+00000215 d .C2_392
+000002dc d .C2_393
+00000218 d .C2_394
+0000021f d .C2_395
+000002e0 d .C2_396
+00000224 d .C2_397
+000002ec d .C2_398
+00000238 d .C2_399
+0000023c d .C2_400
+000002f8 d .C2_401
+00001776 t __endg1d_END
+00000765 t __writeg1d_END
+00000028 C comcstfi_
+00031f3c C comg1dc_
+0000001c C comg1di_
+00000008 C comg1dl_
+00000770 T endg1d_
+         U ftn_str_copy
+         U ftn_strcmp
+         U pgf90_compiled
+         U pgf90_exit
+         U pgf90_template1v
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pgf90io_unf_end
+         U pgf90io_unf_init
+         U pgf90io_unf_write
+         U pghpfio_fmt_write
+00000010 T writeg1d_
+
+writestd.o:
+00000000 b .BSS1
+00000158 d .C1_283
+00000154 d .C1_285
+00000110 d .C1_299
+0000004a d .C1_333
+000000b8 d .C1_335
+0000014c d .C1_336
+00000000 d .C1_337
+00000150 d .C1_341
+000000bc d .C1_342
+000000c0 d .C1_344
+000000c4 d .C1_345
+000000c8 d .C1_346
+000000cc d .C1_347
+000000d0 d .C1_348
+000000d4 d .C1_349
+00000114 d .C1_350
+00000124 d .C1_351
+000000d8 d .C1_353
+00000130 d .C1_354
+000000dc d .C1_355
+000000e0 d .C1_356
+000000e4 d .C1_357
+000000e8 d .C1_358
+00000015 d .C1_359
+00000134 d .C1_360
+0000001d d .C1_361
+0000001f d .C1_363
+000000ec d .C1_365
+00000024 d .C1_367
+000000f0 d .C1_368
+00000144 d .C1_369
+000000f4 d .C1_371
+00000138 d .C1_372
+00000034 d .C1_373
+000000f8 d .C1_378
+000000fc d .C1_379
+00000100 d .C1_380
+00000104 d .C1_381
+00000108 d .C1_382
+0000010c d .C1_383
+00000118 d .C1_384
+0000011c d .C1_385
+00000037 d .C1_386
+00000120 d .C1_387
+00000128 d .C1_388
+00000047 d .C1_389
+00000048 d .C1_390
+0000012c d .C1_391
+00000038 d .C1_392
+0000003d d .C1_393
+00000042 d .C1_394
+0000013c d .C1_395
+00000140 d .C1_397
+00000049 d .C1_399
+00000148 d .C1_400
+0000009f d .C1_401
+000000a7 d .C1_402
+00001ad2 t __writestd_END
+         U ftn_str_copy
+         U ftn_str_cpy1
+         U ftn_strcmp
+00000004 C indexfil_
+         U isitor_
+         U ismax_
+         U ismin_
+00000934 C lmdstdch_
+0000012c C lmdstdnu_
+         U lnblnk_
+         U pgf90_compiled
+         U pgf90_template1v
+         U pgf90io_close
+         U pgf90io_encode_fmt
+         U pgf90io_fmt_write
+         U pgf90io_fmtw_end
+         U pgf90io_fmtw_init
+         U pgf90io_ldw
+         U pgf90io_ldw_a
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_open
+         U pgf90io_src_info
+         U pghpfio_fmt_write
+         U to36_
+00000010 T writestd_
+
+wstats.o:
+00000000 b .BSS1
+00000c30 b .BSS2
+000000ec d .C1_283
+000000e8 d .C1_285
+000000e0 d .C1_345
+000000e4 d .C1_347
+00000000 d .C1_640
+00000008 d .C1_641
+00000011 d .C1_642
+00000019 d .C1_643
+00000021 d .C1_644
+00000079 d .C1_646
+000000d0 d .C1_648
+00000025 d .C1_649
+000000d4 d .C1_654
+0000003a d .C1_655
+00000076 d .C1_658
+0000004d d .C1_659
+000000d8 d .C1_665
+000000d0 d .C1_666
+000000dc d .C1_670
+000000f0 d .STATICS1
+00000138 d .STATICS2
+00001b14 t __inivar_END
+00001765 t __wstats_END
+         U def_var_
+         U ftn_str_copy
+         U ftn_str_free
+         U ftn_str_malloc
+         U ftn_strcmp
+         U inistats_
+00001770 T inivar_
+         U nccre_
+         U ncddef_
+         U ncdid_
+         U ncopn_
+         U ncsfil_
+         U nctlen_
+         U ncvdef_
+         U ncvid_
+         U nf__create_
+         U nf__create_mp_
+         U nf__enddef_
+         U nf__open_
+         U nf__open_mp_
+         U nf_abort_
+         U nf_close_
+         U nf_copy_att_
+         U nf_copy_var_
+         U nf_create_
+         U nf_def_dim_
+         U nf_def_var_
+         U nf_del_att_
+         U nf_delete_
+         U nf_enddef_
+         U nf_get_att_double_
+         U nf_get_att_int1_
+         U nf_get_att_int2_
+         U nf_get_att_int_
+         U nf_get_att_real_
+         U nf_get_att_text_
+         U nf_get_var1_double_
+         U nf_get_var1_int1_
+         U nf_get_var1_int2_
+         U nf_get_var1_int_
+         U nf_get_var1_real_
+         U nf_get_var1_text_
+         U nf_get_var_double_
+         U nf_get_var_int1_
+         U nf_get_var_int2_
+         U nf_get_var_int_
+         U nf_get_var_real_
+         U nf_get_var_text_
+         U nf_get_vara_double_
+         U nf_get_vara_int1_
+         U nf_get_vara_int2_
+         U nf_get_vara_int_
+         U nf_get_vara_real_
+         U nf_get_vara_text_
+         U nf_get_varm_double_
+         U nf_get_varm_int1_
+         U nf_get_varm_int2_
+         U nf_get_varm_int_
+         U nf_get_varm_real_
+         U nf_get_varm_text_
+         U nf_get_vars_double_
+         U nf_get_vars_int1_
+         U nf_get_vars_int2_
+         U nf_get_vars_int_
+         U nf_get_vars_real_
+         U nf_get_vars_text_
+         U nf_inq_
+         U nf_inq_att_
+         U nf_inq_attid_
+         U nf_inq_attlen_
+         U nf_inq_attname_
+         U nf_inq_atttype_
+         U nf_inq_base_pe_
+         U nf_inq_dim_
+         U nf_inq_dimid_
+         U nf_inq_dimlen_
+         U nf_inq_dimname_
+         U nf_inq_format_
+         U nf_inq_libvers_
+         U nf_inq_natts_
+         U nf_inq_ndims_
+         U nf_inq_nvars_
+         U nf_inq_unlimdim_
+         U nf_inq_var_
+         U nf_inq_vardimid_
+         U nf_inq_varid_
+         U nf_inq_varname_
+         U nf_inq_varnatts_
+         U nf_inq_varndims_
+         U nf_inq_vartype_
+         U nf_issyserr_
+         U nf_open_
+         U nf_put_att_double_
+         U nf_put_att_int1_
+         U nf_put_att_int2_
+         U nf_put_att_int_
+         U nf_put_att_real_
+         U nf_put_att_text_
+         U nf_put_var1_double_
+         U nf_put_var1_int1_
+         U nf_put_var1_int2_
+         U nf_put_var1_int_
+         U nf_put_var1_real_
+         U nf_put_var1_text_
+         U nf_put_var_double_
+         U nf_put_var_int1_
+         U nf_put_var_int2_
+         U nf_put_var_int_
+         U nf_put_var_real_
+         U nf_put_var_text_
+         U nf_put_vara_double_
+         U nf_put_vara_int1_
+         U nf_put_vara_int2_
+         U nf_put_vara_int_
+         U nf_put_vara_real_
+         U nf_put_vara_text_
+         U nf_put_varm_double_
+         U nf_put_varm_int1_
+         U nf_put_varm_int2_
+         U nf_put_varm_int_
+         U nf_put_varm_real_
+         U nf_put_varm_text_
+         U nf_put_vars_double_
+         U nf_put_vars_int1_
+         U nf_put_vars_int2_
+         U nf_put_vars_int_
+         U nf_put_vars_real_
+         U nf_put_vars_text_
+         U nf_redef_
+         U nf_rename_att_
+         U nf_rename_dim_
+         U nf_rename_var_
+         U nf_set_base_pe_
+         U nf_set_default_format_
+         U nf_set_fill_
+         U nf_strerror_
+         U nf_sync_
+         U pgf90_compiled
+         U pgf90_dealloc
+         U pgf90_ptr_alloc
+         U pgf90_stop
+         U pgf90_trim
+         U pgf90io_ldw
+         U pgf90io_ldw_end
+         U pgf90io_ldw_init
+         U pgf90io_src_info
+00000068 C sttcom_
+00000010 T wstats_
+
+zerophys.o:
+0000003b t __zerophys_END
+         U pgf90_compiled
+00000010 T zerophys_
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/log_compile_phys
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/log_compile_phys	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/libo/log_compile_phys	(revision 46)
@@ -0,0 +1,660 @@
+Optimisations par defaut suivant les machines
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+apres les opts dim 60
+rm: ne peut enlever `tmp': Aucun fichier ou répertoire de ce type
+dimension avant sed 60
+calcul de la dimension
+dimc is 1
+-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars -I$(LIBF)/dyn3d -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid/dimension
+rm: ne peut enlever `../dimensions.h': Aucun fichier ou répertoire de ce type
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimensions.h'
+!
+!   dimensions.h contient les dimensions du modele
+!   ndm est tel que iim=2**ndm
+!   nqmx est la dimension de la variable traceur q
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: iim= 1
+      INTEGER, parameter :: jjm=1
+      INTEGER, parameter :: llm=60
+      INTEGER, parameter :: ndm=1
+
+      integer, parameter :: nqmx=1
+
+!-----------------------------------------------------------------------
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+dimension 1 dim 60
+pas de dynamique
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+MACRO FILTRE FILTRE= L_FILTRE= 
+dimc 1
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+PHYSIQUE PHYS=mars
+dynamique L_DYN= DYN= L_FILTRE= DIRMAIN=phymars 1
+OPTIM90= -fast FILTRE= L_FILTRE= LIBO=/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg L_DYN= DYN= L_FILTRE= DIRMAIN=phymars PHYS=PHYS=mars DIM=1 PROG=meso_testphys1d
+PATH pour les fichiers INCLUDE -I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars -I$(LIBF)/dyn3d -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include
+OPLINK=
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+make -k RANLIB=ranlib -f /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/makefile OPTION_DEP= OPTION_LINK= -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/lib -lnetcdf -Bstatic  OPTIM90= -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg OPTIMTRU90= -fast -c -Mfree  -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg INCLUDE=-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars -I$(LIBF)/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars FILTRE= L_FILTRE= LIBO=/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg L_DYN= DYN= L_FILTRE= DIRMAIN=phymars PHYS=mars DIM=1 DYNTYPE=dyn L_ADJNT= LOCAL_DIR=/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd F77=pgf90 F90=pgf90 OPLINK= LINK=pgf90  -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg GCM=/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd MOD_LOC_DIR=/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd MOD_SUFFIX=mod AR=ar PROG=meso_testphys1d
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/cbrt.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a cbrt.o ; rm cbrt.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+ar: creating /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/cvmgp.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a cvmgp.o ; rm cvmgp.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/cvmgt.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a cvmgt.o ; rm cvmgt.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/from36.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a from36.o ; rm from36.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/gather.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a gather.o ; rm gather.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ilsum.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ilsum.o ; rm ilsum.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ini36.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ini36.o ; rm ini36.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/isamax.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a isamax.o ; rm isamax.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/isitor.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a isitor.o ; rm isitor.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ismax.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ismax.o ; rm ismax.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ismin.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ismin.o ; rm ismin.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/lnblnk.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a lnblnk.o ; rm lnblnk.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/mxm.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a mxm.o ; rm mxm.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/mxva.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a mxva.o ; rm mxva.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/mxv.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a mxv.o ; rm mxv.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/mywrite.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a mywrite.o ; rm mywrite.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/readcoord.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a readcoord.o ; rm readcoord.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/readstd.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a readstd.o ; rm readstd.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/scatter.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a scatter.o ; rm scatter.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/scopy.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a scopy.o ; rm scopy.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/scopyi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a scopyi.o ; rm scopyi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/sdot.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a sdot.o ; rm sdot.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ssum.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ssum.o ; rm ssum.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/to36.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a to36.o ; rm to36.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/wheneq.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a wheneq.o ; rm wheneq.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/writestd.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a writestd.o ; rm writestd.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -c -Mfree  -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ioipsl_errioipsl.F90 ; \
+	mv /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_errioipsl.mod /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/ioipsl_errioipsl.mod ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ioipsl_errioipsl.o ; rm ioipsl_errioipsl.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+mv: ne peut évaluer `/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_errioipsl.mod': Aucun fichier ou répertoire de ce type
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -c -Mfree  -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ioipsl_stringop.F90 ; \
+	mv /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_stringop.mod /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/ioipsl_stringop.mod ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ioipsl_stringop.o ; rm ioipsl_stringop.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+mv: ne peut évaluer `/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_stringop.mod': Aucun fichier ou répertoire de ce type
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -c -Mfree  -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio/ioipsl_getincom.F90 ; \
+	mv /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_getincom.mod /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/ioipsl_getincom.mod ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libbibio.a ioipsl_getincom.o ; rm ioipsl_getincom.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+mv: ne peut évaluer `/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/ioipsl_getincom.mod': Aucun fichier ou répertoire de ce type
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/aerave.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a aerave.o ; rm aerave.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+ar: creating /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/aeropacity.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a aeropacity.o ; rm aeropacity.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/aeroptproperties.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a aeroptproperties.o ; rm aeroptproperties.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/assim_aeropacity.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a assim_aeropacity.o ; rm assim_aeropacity.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/blackl.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a blackl.o ; rm blackl.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/blendrad.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a blendrad.o ; rm blendrad.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/calldrag_noro.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a calldrag_noro.o ; rm calldrag_noro.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/callradite.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a callradite.o ; rm callradite.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/callsedim2q.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a callsedim2q.o ; rm callsedim2q.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/callsedim.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a callsedim.o ; rm callsedim.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/co2snow.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a co2snow.o ; rm co2snow.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/convadj.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a convadj.o ; rm convadj.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/cvmgp.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a cvmgp.o ; rm cvmgp.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/cvmgt.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a cvmgt.o ; rm cvmgt.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/datareadnc.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a datareadnc.o ; rm datareadnc.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/drag_noro.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a drag_noro.o ; rm drag_noro.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/dustdevil.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a dustdevil.o ; rm dustdevil.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/dustlift.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a dustlift.o ; rm dustlift.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/eofdump.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a eofdump.o ; rm eofdump.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/flusv.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a flusv.o ; rm flusv.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/growthrate.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a growthrate.o ; rm growthrate.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/gwprofil.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a gwprofil.o ; rm gwprofil.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/gwstress.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a gwstress.o ; rm gwstress.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/ineofdump.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a ineofdump.o ; rm ineofdump.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/iniorbit.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a iniorbit.o ; rm iniorbit.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/inistats.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a inistats.o ; rm inistats.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/initracer.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a initracer.o ; rm initracer.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/iniwrite.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a iniwrite.o ; rm iniwrite.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/interp_line.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a interp_line.o ; rm interp_line.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/ismax.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a ismax.o ; rm ismax.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/ismin.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a ismin.o ; rm ismin.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwb.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwb.o ; rm lwb.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwdiff.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwdiff.o ; rm lwdiff.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwflux.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwflux.o ; rm lwflux.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwi.o ; rm lwi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwmain.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwmain.o ; rm lwmain.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwtt.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwtt.o ; rm lwtt.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwu.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwu.o ; rm lwu.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwxb.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwxb.o ; rm lwxb.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwxd.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwxd.o ; rm lwxd.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/lwxn.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a lwxn.o ; rm lwxn.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_inifis.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a meso_inifis.o ; rm meso_inifis.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+PGF90-S-0076-Subscripts specified for non-array variable inertiedat (/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_inifis.F: 163)
+PGF90-S-0072-Assignment operation illegal to external procedure inertiedat (/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_inifis.F: 163)
+PGF90-S-0038-Symbol, inertiedat, has not been explicitly declared (/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_inifis.F)
+  0 inform,   0 warnings,   3 severes, 0 fatal for meso_inifis
+ar: meso_inifis.o: No such file or directory
+rm: ne peut enlever `meso_inifis.o': Aucun fichier ou répertoire de ce type
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/soil.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a soil.o ; rm soil.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_physiq.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a meso_physiq.o ; rm meso_physiq.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+PGF90-F-0226-Can't find include file wrf_output_2d.h (/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_physiq.F: 154)
+PGF90/x86 Linux 7.1-6: compilation aborted
+ar: meso_physiq.o: No such file or directory
+rm: ne peut enlever `meso_physiq.o': Aucun fichier ou répertoire de ce type
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/mucorr.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a mucorr.o ; rm mucorr.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/mufract.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a mufract.o ; rm mufract.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/multipl.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a multipl.o ; rm multipl.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/newcondens.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a newcondens.o ; rm newcondens.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/newsedim.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a newsedim.o ; rm newsedim.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/nirco2abs.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a nirco2abs.o ; rm nirco2abs.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/nltecool.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a nltecool.o ; rm nltecool.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/nlthermeq.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a nlthermeq.o ; rm nlthermeq.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/orbite.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a orbite.o ; rm orbite.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/orodrag.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a orodrag.o ; rm orodrag.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/orosetup.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a orosetup.o ; rm orosetup.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/phyetat0.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a phyetat0.o ; rm phyetat0.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/physdem1.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a physdem1.o ; rm physdem1.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/profile.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a profile.o ; rm profile.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/scatter.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a scatter.o ; rm scatter.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/scopyi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a scopyi.o ; rm scopyi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/soil_settings.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a soil_settings.o ; rm soil_settings.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/solang.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a solang.o ; rm solang.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/solarlong.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a solarlong.o ; rm solarlong.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/sugwd.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a sugwd.o ; rm sugwd.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/sulw.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a sulw.o ; rm sulw.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/surfini.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a surfini.o ; rm surfini.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/swmain.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a swmain.o ; rm swmain.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/swrayleigh.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a swrayleigh.o ; rm swrayleigh.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/swr_fouquart.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a swr_fouquart.o ; rm swr_fouquart.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/swr_toon.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a swr_toon.o ; rm swr_toon.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/tabfi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a tabfi.o ; rm tabfi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/updatereffrad.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a updatereffrad.o ; rm updatereffrad.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/vdif_cd.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a vdif_cd.o ; rm vdif_cd.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/vdifc.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a vdifc.o ; rm vdifc.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/vdif_kc.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a vdif_kc.o ; rm vdif_kc.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/vlz_fi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a vlz_fi.o ; rm vlz_fi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/watercloud.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a watercloud.o ; rm watercloud.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/watersat.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a watersat.o ; rm watersat.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/writediagfi.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a writediagfi.o ; rm writediagfi.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/writeg1d.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a writeg1d.o ; rm writeg1d.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/zerophys.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a zerophys.o ; rm zerophys.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/assim_readtesassim.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a assim_readtesassim.o ; rm assim_readtesassim.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/def_var.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a def_var.o ; rm def_var.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/iniwritesoil.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a iniwritesoil.o ; rm iniwritesoil.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/mkstat.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a mkstat.o ; rm mkstat.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/param_slope.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a param_slope.o ; rm param_slope.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/param_slope_full.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a param_slope_full.o ; rm param_slope_full.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/readtesassim.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a readtesassim.o ; rm readtesassim.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/suaer.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a suaer.o ; rm suaer.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/writediagsoil.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a writediagsoil.o ; rm writediagsoil.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/wstats.F90 ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libphymars.a wstats.o ; rm wstats.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/calchim.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a calchim.o ; rm calchim.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+ar: creating /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/chemthermos.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a chemthermos.o ; rm chemthermos.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/ch.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a ch.o ; rm ch.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/column.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a column.o ; rm column.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/concentrations.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a concentrations.o ; rm concentrations.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/conduction.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a conduction.o ; rm conduction.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/dtridgl.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a dtridgl.o ; rm dtridgl.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/euvheat.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a euvheat.o ; rm euvheat.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/flujo.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a flujo.o ; rm flujo.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/getch.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a getch.o ; rm getch.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/hrtherm.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a hrtherm.o ; rm hrtherm.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/inichim_newstart.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a inichim_newstart.o ; rm inichim_newstart.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/inichim_readcallphys.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a inichim_readcallphys.o ; rm inichim_readcallphys.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/init_chimie_B.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a init_chimie_B.o ; rm init_chimie_B.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/interpfast.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a interpfast.o ; rm interpfast.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/intrplf.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a intrplf.o ; rm intrplf.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/inv.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a inv.o ; rm inv.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/jthermcalc.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a jthermcalc.o ; rm jthermcalc.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/moldiffcoeff.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a moldiffcoeff.o ; rm moldiffcoeff.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/moldiff.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a moldiff.o ; rm moldiff.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/molvis.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a molvis.o ; rm molvis.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/paramfoto.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a paramfoto.o ; rm paramfoto.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/param_read.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a param_read.o ; rm param_read.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/perosat.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a perosat.o ; rm perosat.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/phdisrate.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a phdisrate.o ; rm phdisrate.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/photochemist_B.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a photochemist_B.o ; rm photochemist_B.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars/thermosphere.F ; \
+	ar r /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg/libaeronomars.a thermosphere.o ; rm thermosphere.o ; \
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd
+cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg ; ranlib lib*.a ; cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd ;\
+	cd /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd; \
+	pgf90 -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/grid -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/bibio -I. -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/aeronomars -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/dyn3d  -I/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/include  -I/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars -c /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_testphys1d.F -o meso_testphys1d.o ; \
+	pgf90  -fast -module /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg meso_testphys1d.o -L/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libo/LINUXfast_60_t1_reg    -laeronomars -lphymars  -lbibio  -laeronomars  -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L/donnees/aslmd/MODELES/NETCDF/g95_32/netcdf-3.6.1/lib -lnetcdf -Bstatic  -o /donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/meso_testphys1d.e ; rm meso_testphys1d.o 
+PGF90-F-0226-Can't find include file ../dyn3d/disvert.F (/donnees/aslmd/MODELES/LMD_MM_MARS/pgf_32_single/WRFV2/mars_lmd/libf/phymars/meso_testphys1d.F: 602)
+PGF90/x86 Linux 7.1-6: compilation aborted
+/usr/bin/ld: meso_testphys1d.o: No such file: No such file or directory
+rm: ne peut enlever `meso_testphys1d.o': Aucun fichier ou répertoire de ce type
+make: *** [main] Erreur 1
+  0 inform,   0 warnings,   3 severes, 0 fatal for meso_inifis
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm	(revision 46)
@@ -0,0 +1,803 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+   set optim90=" -fast"
+   set optimtru90=" -fast -c -Mfree "
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm.last
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm.last	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm.last	(revision 46)
@@ -0,0 +1,810 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS.BETA.work
+#setenv LIBOGCM /tmp15/emlmd/test_LMDZ.BETA/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_pgi/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_pgi/include
+#else
+#  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_pgi/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_pgi/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+#   set optim90=" -fast"
+#   set optimtru90=" -fast -c -Mfree "
+   set optim=" -O2 -Munroll -Mcache_align"
+   set optim90=" -O2 -Munroll -Mcache_align"
+   set optimtru90=" -O2 -Munroll -Mcache_align"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+##   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set opt_link=" -L$NCDFLIB -lnetcdf -Bstatic"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm -f $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim="$optim -module $libo"
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95	(revision 46)
@@ -0,0 +1,819 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+# 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64_g95/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64_g95/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/g95_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/g95_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'g95' compiler
+# Aymeric : added option for NETCDF libraries
+   set optim90=" -O2 -fno-second-underscore -fstatic -fzero -Wall "
+   set optimtru90=" -O2 -fno-second-underscore -fstatic -fzero -Wall "
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g95' string to pathname
+set nomlib=${machine}_g95
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64_g95
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+#           set optim90="-mcmodel=medium"
+#         Aymeric : thought I'd complete the g95 debugging 
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=pgf90
+#   set f90=pgf90
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to g95
+ set optim90="$optim90 -fmod=$libo"
+ set optimtru90="$optimtru90 -fmod=$libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95.last
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95.last	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_g95.last	(revision 46)
@@ -0,0 +1,812 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS.BETA.work
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+# 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
+#else
+#  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_g95/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_g95/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+# Ehouarn 'g95' compiler
+   set optim="-O3 -fstatic -funroll-loops "
+   set optim90=" -O3 -fstatic -funroll-loops "
+   set optimtru90=" -O3 -fstatic -funroll-loops "
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+   set opt_link=" -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+# Ehouarn: add 'g95' string to pathname
+set nomlib=${machine}_g95
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64_g95
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim="$2" ; set optim90="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+  echo "vous pouvez continuer en repondant oui."
+  echo "Voulez-vous vraiment continuer?"
+  if ( $< == "oui" ) then
+    #remove old dimensions.h file
+    \rm -f $libf/grid/dimensions.h
+  else
+    exit
+  endif
+endif
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=pgf90
+#   set f90=pgf90
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+#if ($code == 'create_etat0' && $VPP) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h                                             
+#     exit                       
+#   endif
+#   set optim90="$optim90"" -X9 -w"
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+# Ehouarn : adapt to g95
+ set optim="$optim -fmod=$libo"
+ set optim90="$optim90 -fmod=$libo"
+ set optimtru90="$optimtru90 -fmod=$libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_ifort
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_ifort	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_ifort	(revision 46)
@@ -0,0 +1,804 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+## Ehouarn & Aymeric: ifort options 
+   set optim90=" -O2 -static -zero -align commons" #-ffree-line-length-huge"
+   set optimtru90=" -O2 -static -zero -align commons" #-ffree-line-length-huge"
+   set opt_link=" -L$NCDFLIB -lnetcdf"
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpi
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpi	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpi	(revision 46)
@@ -0,0 +1,827 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+   ### Aymeric: that could be useless, but user might 
+   ### want to test various mpi at various locations on the disk
+   if ( ! $?WHERE_MPI ) then
+     echo You must initialize the variable WHERE_MPI in your environnement
+     echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+     exit
+   endif
+
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+##-Ktrap=fp
+#   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+   set optim=" -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+   set optim90=" -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+## Aymeric: added handling of large arrays and large memory
+## Aymeric: get rid of -Mfree for mpi
+#   set optimtru90=" -fast -c -Mlarge_arrays -mcmodel=medium" 
+  set optimtru90=" -O2 -I. -Munroll -Mcache_align" #-C #-fpic" #-Mlarge_arrays -mcmodel=medium
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+# Aymeric : -Bstatic might need to be removed for mesoscale applications     
+#   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf" # -Bstatic "
+   set opt_link=" -L$NCDFLIB -lnetcdf -Bstatic" #-r" #-fpic" #-Bstatic" #-Mlarge_arrays -mcmodel=medium
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=$WHERE_MPI/mpif90 #pgf90
+   set f90=$WHERE_MPI/mpif90 #pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim="$optim -module $libo"
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpifort
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpifort	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_mpifort	(revision 46)
@@ -0,0 +1,813 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+ ### Aymeric: that could be useless, but user might 
+ ### want to test various mpi at various locations on the disk
+ if ( ! $?WHERE_MPI ) then
+   echo You must initialize the variable WHERE_MPI in your environnement
+   echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+   exit
+ endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+## Ehouarn & Aymeric: ifort options 
+   set optim90=" -O2 -static -zero -align commons" #-ffree-line-length-huge"
+   set optimtru90=" -O2 -static -zero -align commons" #-ffree-line-length-huge"
+   set opt_link=" -L$NCDFLIB -lnetcdf"
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   #set f77=pgf90
+   #set f90=pgf90 Aymeric
+   set f77=$WHERE_MPI/mpif90
+   set f90=$WHERE_MPI/mpif90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+# set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_pgf
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_pgf	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/makegcm_pgf	(revision 46)
@@ -0,0 +1,815 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+set dyntype="dyn"
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+#### If you want you can set environment variables here
+#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LIBOGCM /tmp15/emlmd/libo
+#if ( `uname -m` == "x86_64" ) then
+## 64 bit machines
+#  setenv NCDFLIB /donnees/emlmd/netcdf64/netcdf-3.6.1/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf64/netcdf-3.6.1/include
+#else
+#  setenv NCDFLIB /distrib/local/netcdf/pgi_32bits/lib
+#  setenv NCDFINC /distrib/local/netcdf/pgi_32bits/include
+#endif
+####
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+# create $libo directory if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+##-Ktrap=fp
+   set optim90=" -fast -I." 
+   set optimtru90=" -fast -c -Mfree" 
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
+# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
+#          also changed -Wl,-Bstatic to -Bstatic
+# Aymeric : -Bstatic might need to be removed for mesoscale applications     
+   set opt_link=" -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+   set mod_loc_dir="" #$localdir
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+# Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
+if (`uname` == Linux && `uname -m` == "x86_64") then
+  set nomlib=${machine}64
+   ## Aymeric: added handling of large arrays and large memory
+   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium"
+   set optimtru90=" -fast -c -Mfree -Mlarge_arrays -mcmodel=medium"
+   ## Aymeric : -Bstatic might need to be removed for mesoscale applications     
+   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Bstatic "
+endif
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+The makegcm script:
+-------------------
+
+1. compiles a series of subroutines located in the $LMDGCM/libf
+ sub-directories.
+ The objects are then stored in the libraries in $LIBOGCM.
+
+2. then, makegcm compiles program prog.f located by default in
+$LMDGCM/libf/dyn3d and makes the link with the libraries.
+
+Environment Variables '$LMDGCM' and '$LIBOGCM'
+ must be set as environment variables or directly
+ in the makegcm file.
+
+The makegcm command is used to control the different versions of the model
+ in parallel, compiled using the compilation options 
+ and the various dimensions, without having to recompile the whole model.
+
+The FORTRAN libraries are stored in directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+The following options can either be defined by default by editing the
+makegcm "script", or in interactive mode:
+
+-d imxjmxlm  where im, jm, and lm are the number of longitudes,
+             latitudes and vertical layers respectively.
+
+-t ntrac   Selects the number of tracers present in the model
+
+             Options -d and -t overwrite file 
+             $LMDGCM/libf/grid/dimensions.h
+             which contains the 3 dimensions of the
+             horizontal grid 
+             im, jm, lm plus the number of tracers passively advected
+             by the dynamics ntrac,
+             in 4 PARAMETER FORTRAN format 
+             with a new file:
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             If the file does not exist already
+             it is created by the script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    Selects the set of physical parameterizations
+           you want to compile the model with.
+           The model is then compiled using the physical
+           parameterization sources in directory:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  Selects the grid type.
+           This option overwrites file
+           $LMDGCM/libf/grid/fxyprim.h
+           with file
+           $LMDGCM/libf/grid/fxy_grille.h
+           the grid can take the following values:
+           1. reg - the regular grid
+           2. sin - to obtain equidistant points in terms of sin(latitude)
+           3. new - to zoom into a part of the globe
+
+-O "compilation options" set of fortran compilation options to use
+
+-include path
+           Used if the subroutines contain #include files (ccp) that 
+           are located in directories that are not referenced by default.
+
+-adjnt     Compiles the adjoint model to the dynamical code.
+
+-olddyn    To compile GCM with "old dynamics"
+
+-filtre  filter
+           To select the longitudinal filter in the polar regions.
+           "filter" corresponds to the name of a directory located in
+           $LMDGCM/libf. The standard filter for the model is "filtrez"
+           which can be used for a regular grid and for a  
+           grid with longitudinal zoom.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+           Adds a link to FORTRAN libraries
+           libfile1.a, libfile2.a ... 
+           located in directories dir1, dir2 ...respectively
+           If dirn is a directory with an automatic path 
+           (/usr/lib ... for example) 
+           there is no need to specify  -Ldirn.
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -olddyn
+        set dyntype="olddyn" ; shift; goto top
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+        else 
+           echo "pas d option debug predefinie pour cette machine"
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo "apres les opts dim $dim"
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+
+# dimension
+
+echo "dimension avant sed $dim"
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+
+# build final name of libraries directory:
+if ( "$dyntype" == "olddyn" ) then
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}_olddyn
+else
+  set nomlib=${nomlib}_${dim_}_t${ntrac}_${grille}
+endif
+
+# Append 'physique' type, if it is not mars, to nomlib
+if ( "$physique" != "mars" ) then
+  set nomlib=${nomlib}_${physique}
+endif
+
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+
+echo "calcul de la dimension"
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+  set include="$include "'-I$(LIBF)/dyn2d '
+  set dimh=$dim
+else
+  if ( "$dyntype" == "olddyn" ) then
+    set include="$include "'-I$(LIBF)/olddyn3d '
+  else
+    set include="$include "'-I$(LIBF)/dyn3d '
+  endif
+  set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo "dimc is $dimc"
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#if ( -f dimensions.h ) then
+#  echo "ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs"
+#  echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#  echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#  echo "vous pouvez continuer en repondant oui."
+#  echo "Voulez-vous vraiment continuer?"
+#  if ( $< == "oui" ) then
+#    #remove old dimensions.h file
+#    \rm $libf/grid/dimensions.h
+#  else
+#    exit
+#  endif
+#endif
+#### Aymeric: commented for mesoscale purposes
+
+# Build the appropriate 'dimensions.h' file
+cd dimension
+makdim $ntrac $dim
+# echo contents of dimensions.h to standard output
+cat $libf/grid/dimensions.h
+#### Aymeric: necessary for nests, just add lines if more than 4 nests
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+cd $LMDGCM
+# set path to objects directory
+set libo=$libo/$nomlib
+# create objects directory, if it doesn't exist
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+  echo pas de dynamique
+  set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+
+cd $model
+if ( $dimension == 3 ) then
+  cd libf/grid
+  \rm fxyprim.h
+  cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+  if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+    \rm $libf/phy$physique/raddim.h
+    cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+    echo $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.$dimh.h 
+    cat $libf/phy$physique/raddim.h
+  else
+    echo On peut diminuer la taille de l executable en creant
+    echo le fichier $libf/phy$physique/raddim.$dimh.h
+    \cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+  endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+# set filtre to 'oldfiltrez' if using -olddyn option
+if ( "$dyntype" == "olddyn" ) then
+  set filtre="oldfiltrez"
+endif
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo "MACRO FILTRE $filtre"
+
+echo "dimc $dimc"
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo "les fichiers suivants ont ete crees ou detruits"
+        echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo "On recree le makefile"
+        if ("$dyntype" == "olddyn") then
+          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
+        else
+          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
+        endif
+        \mv tmp makefile
+        echo "Nouveau makefile cree."
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+  set make="gmake RANLIB=ls"
+else if $CRAY then
+  set make="make RANLIB=ls"
+else if $NEC then
+  set make="make RANLIB=ls"
+else if $LINUX then
+  set make="make -k RANLIB=ranlib"
+else if $XNEC then
+  set make="/usr/local/bin/gmake RANLIB=ls"
+  set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+  set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set optimtru90="$optimtru90 -module $libo"
+# Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+DYNTYPE="$dyntype" \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_g95
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_g95	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_g95	(revision 46)
@@ -0,0 +1,771 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set optim90=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -fno-second-underscore -fstatic -fzero" 
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=g95
+   set f90=g95
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+# set optim90="$optim90 -module $libo"
+# set mod_loc_dir=$libo
+
+ set optimtru90=" $optimtru90 -fmod=$libo  "
+ set optim90=" $optim90 -fmod=$libo  "
+ set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_ifort
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_ifort	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_ifort	(revision 46)
@@ -0,0 +1,770 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optim90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=ifort
+   set f90=ifort
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+ #set optimtru90=" $optimtru90 -fmod=$libo  "
+ #set optim90=" $optim90 -fmod=$libo  "
+ #set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpi
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpi	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpi	(revision 46)
@@ -0,0 +1,757 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?WHERE_MPI ) then
+    echo You must initialize the variable WHERE_MPI in your environnement
+    echo for instance: "setenv WHERE_MPI /home/install_mpi/bin" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+## newmodif 01042009
+   set optimtru90=" -fast -c -Mlarge_arrays -mcmodel=medium" 
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=""
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+#           set optim90="-mcmodel=medium"
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#*********WRF
+#if ( -f dimensions.h ) then
+#echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+#echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#echo  vous pouvez continuer en repondant oui.
+#echo "Voulez-vous vraiment continuer?"
+#if ( $< == "oui" ) then
+#\rm $libf/grid/dimensions.h
+#else
+#exit
+#endif
+#endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+#*********WRF nest
+#a completer par la suite
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=$WHERE_MPI/mpif90 #pgf90
+   set f90=$WHERE_MPI/mpif90 #pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpifort
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpifort	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_mpifort	(revision 46)
@@ -0,0 +1,772 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+
+#--------------------------------------------------------
+#   set optim90=" -fast -I."
+#   set optimtru90=" -fast -c -Mfree "
+##   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+#   set mod_loc_dir=""
+#   set mod_suffix=mod
+#
+#-ffixed-form
+#   
+set optim=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optim90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set optimtru90=" -O2 -static -zero -align commons"
+#-ffree-line-length-huge"
+set opt_link=" -L$NCDFLIB -lnetcdf"
+set mod_loc_dir=""
+set mod_suffix=mod
+#--------------------------------------------------------
+   
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+#           set optim90="-g -Mbounds "
+##           set optim90="-mcmodel=medium"
+#-------------------------------------------------------------------
+          set optim="$optim"" -g -fbounds-check "
+          set optim90="$optim90"" -g -fbounds-check "
+          set optimtru90="$optimtru90"" -g -fbounds-check "
+#-------------------------------------------------------------------
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+if ( -f dimensions.h ) then
+echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+echo  vous pouvez continuer en repondant oui.
+echo "Voulez-vous vraiment continuer?"
+if ( $< == "oui" ) then
+\rm $libf/grid/dimensions.h
+else
+exit
+endif
+endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+#   set f77=mpif90
+#   set f90=mpif90
+   set f77=$WHERE_MPI/mpif90
+   set f90=$WHERE_MPI/mpif90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+#----------------------------------------------
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+ #set optimtru90=" $optimtru90 -fmod=$libo  "
+ #set optim90=" $optim90 -fmod=$libo  "
+ #set mod_loc_dir=$libo
+#----------------------------------------------
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
Index: trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_pgf
===================================================================
--- trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_pgf	(revision 46)
+++ trunk/mesoscale/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new.bak/oldmakegcm/makegcm_pgf	(revision 46)
@@ -0,0 +1,754 @@
+#!/bin/csh
+# $Header: /users/lmdz/cvsroot/LMDZ.3.3/makegcm,v 1.21 2001/07/04 08:41:44 lmdz Exp $
+#set verbose echo
+########################################################################
+# options par defaut pour la commande make
+########################################################################
+set dim="64x48x32"
+set physique=mars
+set phys="PHYS=$physique"
+set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set ntrac = 1
+set filtre=filtrez
+set grille=reg
+########################################################################
+# path a changer contenant les sources et les objets du modele
+########################################################################
+
+###### VERSION LMDZ.3.3
+# set LMDGCM=$HOME/LMDZ.3.3
+#
+
+setenv localdir "`pwd`"
+set MODIPSL=0
+echo $localdir | grep modipsl >& /dev/null
+if ( ! $status ) then
+  set MODIPSL=1
+  setenv LMDGCM $localdir
+  cd ../..
+  setenv LIBOGCM "`pwd`/lib"
+  cd $localdir
+  if ( `hostname` == rhodes ) then
+    set NCDFINC=`grep sxnec ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+    set NCDFLIB=`grep sxnec ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+  else
+    if ( `hostname` == nymphea0 ) then
+      set NCDFINC=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_INC|sed -e "s/^.* =//"`
+      set NCDFLIB=`grep fjvpp ../../util/AA_make.gdef| grep NCDF_LIB|sed -e 's/^.* =//'`
+    else
+      echo 'Probleme de definition des variables NCDFINC et NCDFLIB'
+    endif 
+  endif 
+else
+  if ( ! $?LMDGCM ) then
+    echo You must initialize the variable LMDGCM in your environnement
+    echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
+    exit
+  endif
+  if ( ! $?LIBOGCM ) then
+    set LIBOGCM=$LMDGCM/libo
+  endif
+  if ( ! $?NCDFLIB ) then
+    echo You must initialize the variable NCDFLIB in your environnement
+    echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+  if ( ! $?NCDFINC ) then
+    echo You must initialize the variable NCDFINC in your environnement
+    echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
+    exit
+  endif
+endif
+set model=$LMDGCM
+set libo=$LIBOGCM
+
+########################################################################
+#  Les differentes platformes reconnues
+########################################################################
+
+set HP=0
+set IBM=0
+set SUN=0
+set VPP=0
+set CRAY=0
+set DEC=0
+set LINUX=0
+set NEC=0
+set XNEC=0
+echo "coucou"
+echo `uname`
+if ( `uname` == HP-UX ) then
+   set machine=HP
+   set HP=1
+else if (`uname` == UNIX_System_V ) then
+   set machine=VPP
+   set VPP=1
+else if (`uname` == SunOS ) then
+   set machine=SUN
+   set SUN=1
+else if ( `uname` == AIX ) then
+   set machine=IBM
+   set IBM=1
+else if ( `uname` == OSF1 ) then
+   set machine=ALPHA
+   set DEC=1
+else if ( `uname` == Linux ) then
+   set machine=LINUX
+   set LINUX=1
+else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
+   set machine=CRAY
+   set CRAY=1
+else if ( `uname` == SUPER-UX ) then
+   set machine=NEC
+   set NEC=1
+else if ( `hostname` == rhodes) then
+   set machine=XNEC
+   set XNEC=1
+else
+   echo Vous travaillez sur une machine non prevue par le reglement
+   exit
+endif
+
+if ( ! -d $libo )  then
+   mkdir $libo
+endif
+
+
+if $VPP then
+set netcdf=netcdf_v
+else 
+set netcdf=netcdf
+endif
+########################################################################
+#  Quelques initialisations de variables du shell.
+########################################################################
+
+set dyn=
+set opt_link=""
+set adjnt=""
+set opt_dep=""
+
+set optim90=""
+set oplink=""
+
+########################################################################
+#  Optimisations par defaut suivant les machines
+########################################################################
+
+echo "Optimisations par defaut suivant les machines"
+set libf=$model/libf
+#setenv localdir "LOCAL_DIR=`pwd`"
+#setenv localdir "`pwd`"
+cd $model
+if $CRAY then
+   set optim90="-Wp'-P' -DCRAY "'-p$(LIBO) -eiv '
+   set oplink="-Wl'-DSTACK=128 -f indef' -L$NCDFLIB -lnetcdf "
+   set mod_loc_dir=" "
+   set mod_suffix=" "
+else if $SUN then
+   set optim90=" -fast"
+   set optimtru90=" -fast -free"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=$localdir
+   set mod_suffix=mod
+else if $HP then
+else if $IBM then
+else if $VPP then
+   set optim90="$optim -X9 -w"
+   if $COUPLE then
+     set opt_link="-Wg,-c $IOIPSLDIR/liboasis2.4_mpi2.a /usr/lang/mpi2/lib64/libmpi.a /usr/lang/mpi2/lib64/libmp.a /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-P,-dy "
+   else
+     set opt_link="-Wg,-c /usr/local/lib/lib64/libnetcdf_cc.a -L$IOIPSLDIR -lioipsl"
+     set oplink="-Wl,-t,-dy "
+   endif
+   set mod_loc_dir=$IOIPSLDIR
+   set mod_suffix=mod
+else if $DEC then
+else if $LINUX then
+##-Ktrap=fp
+   set optim90=" -fast -I. -Mlarge_arrays -mcmodel=medium" 
+## newmodif 01042009
+   set optimtru90=" -fast -c -Mfree -Mlarge_arrays -mcmodel=medium" 
+#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic"
+   set opt_link=" -Mlarge_arrays -mcmodel=medium -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf"
+   set mod_loc_dir=""
+   set mod_suffix=mod
+else if $NEC then
+   set optim90=' -clear -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+   set optimtru90=' -clear -f4 -C hopt -float0 -ew -P static -Wf,"-pvctl fullmsg noassume "'
+###   set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lioipsl  -L/u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v "
+   set opt_link=" -C hopt -float0 -ew -P static -L/SX/usr/local/lib  -lnetcdf_i8r8 "
+   set mod_loc_dir="."
+   set mod_suffix="mod"
+else if $XNEC then
+   set optim90=' -clear -R5 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   set optimtru90=' -clear -R5 -f4 -C vopt -float0 -ew -P static -Wf,"-pvctl loopcnt=40000 fullmsg noassume "'
+   if $MODIPSL then
+     if $COUPLE then
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -loasis2.4_mpi2 -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     else
+       set opt_link="-L$IOIPSLDIR -lsxioipsl -float0 -ew -P static -I$NCDFINC $NCDFLIB "
+     endif
+     set mod_loc_dir="./"
+   else
+####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
+     set mod_loc_dir="."
+   endif
+   set mod_suffix="mod"
+
+endif
+
+set nomlib=$machine
+
+########################################################################
+# lecture des options de mymake
+########################################################################
+
+top:
+if ($#argv > 0) then
+    switch ($1:q)
+
+    case -h:
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makegcm [Options] prog
+
+
+
+
+Par default, la commande makegcm:
+---------------------------------
+
+1. compile une serie de sous programmes se trouvant dans des sous-repertoires
+de $LMDGCM/libf.
+Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
+sur $LIBOGCM.
+
+2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
+$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
+
+La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
+dans la comande makegcm.
+
+La commande makegcm est faite pour permettre de gerer en parallele des
+versions differentes du modele, compilees avec des options de compilation
+et des dimensions differentes sans avoir a chaque fois a recompiler tout
+le modele.
+
+Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
+
+
+OPTIONS:
+--------
+
+Les options suivantes peuvent etre definies soit par defaut en editant le
+"script" makegcm, soit en interactif:
+
+-d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
+             et couches verticales. 
+
+-t ntrac   selectionne le nombre de traceur advectes par la dynamique.
+           Dans les versions courantes du modele terrestre on a par exemple
+           ntrac=2 pour l'eau vapeur et liquide
+
+             L'effet des options -d et -t est d'ecraser le fichier 
+             $LMDGCM/libf/grid/dimensions.h
+             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
+             de la grille horizontale im, jm, lm plus le nombre de traceurs
+             advectes passivement par la dynamique ntrac, par un nouveu fichier
+             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
+             Si ce fichier n'existe pas encore, il est cree par le script
+             $LMDGCM/libf/grid/dimension/makdim
+
+-p PHYS    pour selectionner le jeu de parametrisations physiques avec
+           lequel on veut compiler le modele.
+           Le modele sera alors compile en prenant les sources des
+           parametrisations physiques dans le repertoire:
+            $LMDGCM/libf/phyPHYS
+
+-g grille  selectionne le type de grille qu'on veut utiliser.
+           L'effet de cette option est d'ecraser le fichier
+           $LMDGCM/libf/grid/fxyprim.h
+           avec le fichier
+           $LMDGCM/libf/grid/fxy_grille.h
+           grille peut prendre les valeurs:
+           1. reg pour la grille reguliere
+           2. sin pour avoir des points equidistants en sinus de la latitude
+           3. new pour pouvoir zoomer sur une partie du globe
+
+-O "optimisation fortran" ou les optimisations fortran sont les options de la
+            commande f77
+
+-include path
+           Dans le cas ou on a dans des sous programmes des fichiers 
+           #include (cpp) qui se trouve sur des repertoires non references
+           par defaut
+
+-adjnt     Pour compiler la l'adjoint du code dynamique
+
+-filtre  filtre
+           Pour choisir le filtre en longitude dans les regions polaires.
+           "filtre" correspond au nom d'un repertoire se trouvant sur
+           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
+           etre utilise aussi bien pour une grille reguliere que pour une 
+           grille zoomee en longitude.
+
+-link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
+          Pour rajouter un lien avec les librairies FORTRAN
+          libfile1.a, libfile2.a ... se trouvant respectivement sur les
+          repertoires dir1, dir2 ...
+          Si dirn est un repertoire dont le chemin est automatique (comme
+          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
+
+Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -d:
+        set dim=$2 ; shift ; shift ; goto top
+                        
+    case -O:
+        set optim90="$2" ; shift ; shift ; goto top
+
+     case -p
+        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
+
+     case -g
+        set grille="$2" ; shift ; shift ; goto top
+
+     case -t
+        set ntrac=$2 ; shift ; shift ; goto top
+
+     case -include
+        set include="$include -I$2" ; shift ; shift ; goto top
+
+     case -adjnt
+        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
+
+     case -filtre
+        set filtre=$2 ; shift ; shift ; goto top
+
+     case -link
+        set opt_link="$opt_link $2" ; shift ; shift ; goto top
+
+     case -debug
+        if $HP then
+           set optim90=" -g "
+        else if $SUN then
+           setenv PARALLEL 4
+           set optim90=" -g -C "
+           set optimtru90=" -g -C "
+        else if $CRAY then
+           set optim90="$optim90"" -G1 "
+        else if $LINUX then
+           set optim90="-g -Mbounds "
+#           set optim90="-mcmodel=medium"
+        else 
+           echo pas d option debug predefinie pour cette machine
+           exit
+        endif
+        shift ; goto top
+
+     default
+        set code="$1" ; shift ; goto top
+
+   endsw
+endif
+
+echo apres les opts dim $dim
+
+########################################################################
+# cas special sans physique
+########################################################################
+if ( "$physique" == 'nophys' ) then
+   set phys="L_PHY= LIBPHY="
+endif
+
+########################################################################
+# choix du nombre de traceur par defaut si il n'a pas ete choisi,
+# suivant la physique
+########################################################################
+
+if ( $ntrac == 0  ) then
+    if ( "$physique" == 'nophys' ) then
+        set ntrac=1
+    else if ( "$physique" == 'lmd' ) then
+        set ntrac=2
+    else if ( "$physique" == 'lmd_test_li' ) then
+        set ntrac=2
+    else if ( "$physique" == 'ec' ) then
+        set ntrac=1
+    else
+        set ntrac = 1
+    endif
+endif
+
+########################################################################
+#subtilites sur le nom de la librairie
+########################################################################
+
+\rm tmp ; touch tmp
+\rm tmp90 ; touch tmp90
+foreach i ( $optim90 )
+   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g' -e 's/://g' -e 's/=//g' -e 's/%//g' >> tmp
+end
+set suf=
+foreach i ( `sort tmp | uniq ` )
+   set suf=$suf$i
+end
+if ( ! $IBM ) then
+   set nomlib="$nomlib$suf"
+endif
+if ( $DEC ) then
+   set nomlib=DEC
+endif
+echo dimension avant sed $dim
+if ( $IBM ) then
+   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
+   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
+else if ( $SUN || $XNEC ) then
+   set dim=`echo $dim | sed -e 's/[^0-9]/ /g'` 
+   set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+else
+#   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
+#   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
+     set dim=`echo $dim | sed -e 's/[^0-9]/ /g'`
+     set dim_=`echo $dim | sed -e 's/[^0-9]/_/g'`
+endif
+set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
+## M-A-F nomlib trop long sur CRAY pour ar
+if ( $CRAY ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+if ( $NEC || $XNEC ) then
+    set nomlib=F90_${dim_}_t${ntrac}
+endif
+echo calcul de la dimension
+set dimc=`echo $dim | wc -w`
+
+if ( "$dimc" == "2" ) then
+set include="$include "'-I$(LIBF)/dyn2d '
+set dimh=$dim
+else
+set include="$include "'-I$(LIBF)/dyn3d '
+set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
+endif
+echo $dimc
+
+########################################################################
+# path pour les #include
+########################################################################
+
+set include="$include -I$NCDFINC "
+echo $include
+
+########################################################################
+# Gestion des dimensions du modele.
+# on cree ou remplace le fichier des dimensions/nombre de traceur
+########################################################################
+
+cd $libf/grid
+#*********WRF
+#if ( -f dimensions.h ) then
+#echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
+#echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
+#echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
+#echo  vous pouvez continuer en repondant oui.
+#echo "Voulez-vous vraiment continuer?"
+#if ( $< == "oui" ) then
+#\rm $libf/grid/dimensions.h
+#else
+#exit
+#endif
+#endif
+
+cd dimension
+makdim $ntrac $dim
+cat $libf/grid/dimensions.h
+#*********WRF nest
+#a completer par la suite
+cp -f $libf/grid/dimensions.h $libf/grid/d2_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d3_dimensions.h
+cp -f $libf/grid/dimensions.h $libf/grid/d4_dimensions.h
+
+
+
+cd $LMDGCM
+set libo=$libo/$nomlib
+if ( ! -d $libo )  then
+   mkdir $libo
+   cd $model
+endif
+
+########################################################################
+# Differentes dynamiques (3d, 2d, 1d)
+########################################################################
+
+set dimension=`echo $dim | wc -w`
+echo dimension $dimension dim $dim
+if ( $dimension == 1 ) then
+echo pas de dynamique
+set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
+endif
+endif
+cd $model
+if ( $dimension == 3 ) then
+cd libf/grid
+\rm fxyprim.h
+cp -p fxy_${grille}.h fxyprim.h
+endif
+
+######################################################################
+#   Traitement special pour le nouveau rayonnement de Laurent Li.
+######################################################################
+
+if ( -f $libf/phy$physique/raddim.h ) then
+if ( -f $libf/phy$physique/raddim.$dimh.h ) then
+\rm $libf/phy$physique/raddim.h
+cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
+echo $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.$dimh.h 
+cat $libf/phy$physique/raddim.h
+else
+echo On peut diminuer la taille de l executable en creant
+echo le fichier $libf/phy$physique/raddim.$dimh.h
+\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
+endif
+endif
+
+######################################################################
+# Gestion du filtre qui n'existe qu'en 3d.
+######################################################################
+
+if ( `expr $dimc \> 2` == 1 ) then
+   set filtre="FILTRE=$filtre"
+else
+   set filtre="FILTRE= L_FILTRE= "
+endif
+echo MACRO FILTRE $filtre
+
+echo $dimc
+
+########################################################################
+#  Avant de lancer le make, on recree le makefile si necessaire
+########################################################################
+# c'est a dire dans 3 cas:
+# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
+#    derniere creation du makefile
+# 2. si le fichier contenant cette liste "liste_des_sources"
+#    n'existe pas.
+# 3. Si le makefile n'existe pas.
+########################################################################
+
+cd $model
+find libf -name '*.[Fh]' -print >! tmp77
+#find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
+find libf -name '*.[Fh]90' -print >> tmp90
+
+if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
+     || `diff tmp90 liste_des_sources_f90 | wc -w` \
+     || ! -f makefile \
+     || ! -f liste_des_sources_f90 \
+     || ! -f liste_des_sources_f77 ) then
+        echo les fichiers suivants ont ete crees ou detruits
+        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
+        diff liste_des_sources_f77 tmp77
+        diff liste_des_sources_f90 tmp90
+        \cp tmp77 liste_des_sources_f77
+        \cp tmp90 liste_des_sources_f90
+        echo On recree le makefile
+        ./create_make_gcm >! tmp
+        \mv tmp makefile
+        echo Nouveau makefile cree.
+endif
+
+########################################################################
+#  Execution de la comande make
+########################################################################
+
+echo PHYSIQUE $phys
+echo dynamique $dyn $dimension
+echo OPTIM90="$optim90" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
+echo PATH pour les fichiers INCLUDE $include
+echo OPLINK="$oplink"
+
+if $HP then
+   set f77='fort77 +OP'
+   set f90='jensaisrien'
+   set opt_link="$opt_link -lm"
+else  if $VPP then
+   set f77=frt
+   set f90=$f77
+else if $CRAY then
+   set f77=f90
+   set f90=f90
+else if $LINUX then
+   set f77=pgf90
+   set f90=pgf90
+else if $SUN then
+   set f77=f90
+   set f90=f90
+else if $NEC then
+   set f77=f90
+   set f90=f90
+else if $XNEC then
+   set f77=sxmpif90
+   set f90=sxmpif90
+else
+   set f77=f77
+   set f90=f90
+endif
+
+cd $model
+
+if $VPP then
+set make="gmake RANLIB=ls"
+else if $CRAY then
+set make="make RANLIB=ls"
+else if $NEC then
+set make="make RANLIB=ls"
+else if $LINUX then
+set make="make -k RANLIB=ranlib"
+else if $XNEC then
+set make="/usr/local/bin/gmake RANLIB=ls"
+set make="/usr/freeware/bin/gmake RANLIB=ls"
+else
+set make="make RANLIB=ranlib"
+endif
+
+
+
+#
+# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
+# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
+#
+#if ($code == 'create_limit' && $SUN) then
+#   set link=f77
+#   set opt_link="-L$NCDFLIB -lnetcdf"
+#endif
+
+#if ($code == 'create_etat0' && $SUN) then
+#   if ( ! -f $libo/libdyn3d.a ) then
+#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+#     \rm $libf/grid/dimensions.h
+#     exit
+#   endif
+#   set optim90=" -dalign -fixed "
+#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
+#   set link="$f90 $optim90"
+#   touch $LMDGCM/libf/dyn3d/startvar.F
+#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+#endif
+
+#
+# Encore un test temporaire: probleme de compilation sur VPP
+# l'optimisation de startvar se passe mal
+#
+if ($code == 'create_etat0' && $VPP) then
+   if ( ! -f $libo/libdyn3d.a ) then
+     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
+     \rm $libf/grid/dimensions.h                                             
+     exit                       
+   endif
+   set optim90="$optim90"" -X9 -w"
+   set opt_link="-L$NCDFLIB -lnetcdf"
+   touch $LMDGCM/libf/dyn3d/startvar.F
+   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
+endif
+
+#
+# etat0_netcdf a besoin d'info de la physique
+# A revoir
+set include="$include"" -I$libf/phy$physique"
+
+
+#################################################################
+# Execution de la comande make... ENFIN!
+#################################################################
+
+if $VPP then
+  set optim90=" $optim90 -Am -M$libo"
+  set optimtru90="$optim90"
+else if $SUN then
+ set optim90=" $optim90 -M$libo"
+ set optimtru90=" $optimtru90 "
+else if $NEC then
+ set optim90=" $optim90 -I$libo "
+else if $XNEC then
+ set optim90=" $optim90 -I$libo "
+ set optimtru90=" $optimtru90 -I$libo "
+else if $LINUX then
+ set optim90="$optim90 -module $libo"
+ set mod_loc_dir=$libo
+endif
+
+set link="$f90 $optim90"
+
+set ar=ar
+
+if $XNEC then
+  set link="sxld $opt_link"
+  set link="$f90 "
+#  set ar=sxar
+endif
+
+
+cd $localdir
+
+echo $make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+
+$make -f $LMDGCM/makefile \
+OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM90="$optim90" \
+OPTIMTRU90="$optimtru90" \
+INCLUDE="$include" \
+$filtre \
+LIBO=$libo \
+$dyn \
+$phys \
+DIM=$dimc \
+L_ADJNT="$adjnt" \
+LOCAL_DIR="$localdir"  \
+F77="$f77" \
+F90="$f90" \
+OPLINK="$oplink" \
+LINK="$link" \
+GCM="$LMDGCM" \
+MOD_LOC_DIR=$mod_loc_dir \
+MOD_SUFFIX=$mod_suffix \
+AR=$ar \
+PROG=$code
+
+\rm $libf/grid/dimensions.h
