c======================================================================= *=*=*=*= create_start_archive.html =*=*=*=*
SUBROUTINE create_start_archive

SUBROUTINE create_start_archive


      SUBROUTINE create_start_archive(tsurf,tsoil,emis,q2,
     .             t,ucov,vcov,pext,co2ice,h,phisold_newgrid)
c=======================================================================
c
c
c   Auteur:    08/1998
c   ------
c
c
c   Objet:     Copie sur la Lecture des variables d'un fichier "start_archive"
c              initialise tous les champs a des valeurs constantes
c
c
c=======================================================================

      implicit none

#include "dimensions.h"
#include "../phymars/dimphys.h"
#include "../phymars/surfdat.h"
#include "../phymars/dimradmars.h"
#include "../phymars/yomaer.h"
#include "../phymars/planete.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom2.h"
#include "control.h"
#include "logic.h"
#include "drsdef.h"
#include "description.h"
#include "ener.h"
#include "temps.h"
#include "lmdstd.h"

c=======================================================================
c   Declarations
c=======================================================================

c et autres:
c----------
      INTEGER lnblnk,drsread
      EXTERNAL lnblnk,drsread

c Variable histoire
c------------------
      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
      REAL h(iip1,jjp1,llm),pext(iip1,jjp1)

c autre variables dynamique nouvelle grille
c------------------------------------------

c!-*-
      integer klatdat,klongdat
      PARAMETER (klatdat=180,klongdat=360)

c variable physique
c------------------
      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
      REAL emis(ngridmx)
      REAL q2(ngridmx,nlayermx+1)
c     REAL phisfi(ngridmx)

      INTEGER i,j,l
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 iniconst,geopot,inigeom
      integer ismin
      external ismin
      CHARACTER*80 datapath

c Variable nouvelle grille naturelle au point scalaire
c------------------------------------------------------
      REAL p(iip1,jjp1)
      REAL phisold_newgrid(iip1,jjp1)
      REAL t(iip1,jjp1,llm)

      integer ig
c=======================================================================

c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
c -------------------------------------------------------------------------

#ifdef CRAY
      datapath = '/u/rech/vnz/rvnz001/gcm/newdatamars'
#else
      datapath = '/dw/chourdin/MARS/data_mars'
#endif


c=======================================================================
c   initialisation des variables
c=======================================================================

c Sur grille physique

      do ig=1,ngridmx
          tsurf(ig) = 200.
          emis(ig) = 0.95
          co2ice(ig) = 0.
          do l=1,nsoilmx
              tsoil(ig,l) = 200.
          enddo
          do l=1,llm+1
              q2(ig,l) = 0.
          enddo
      enddo

c Sur grille dynamique

      do j=1,jjp1
         do i=1,iip1
            phisold_newgrid(i,j) = 0.
         enddo
      enddo

      do l=1,llm
         do j=1,jjp1
            do i=1,iip1
               t(i,j,l) = 200.
               ucov( i,j,l ) = 0.
            enddo
         enddo
      enddo

      do l=1,llm
        do j=1,jjm
          do i=1,iip1
            vcov( i,j,l ) = 0.
          end do
        end do
      end do

c-----------------------------------------------------------------------
c	Pas de Traitement special de la pression au sol :
c-----------------------------------------------------------------------

      do j=1,jjp1
        do i=1,iip1
          p(i,j) = 700.
        enddo
      enddo

      do j=1,jjp1
         do i=1,iim
            pext(i,j)=p(i,j)*aire(i,j)
         enddo
         pext(iip1,j) =  pext(1,j)               ! periodicite
      enddo

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)*cpp/(s(l)*p(i,j)**kappa)
            enddo
            h(iip1,j,l) =  h(1,j,l)
         enddo
      enddo




      write(44,*) 'tsurf', tsurf
      write(45,*) 'tsoil', tsoil
      write(46,*) 'emis', emis
      write(47,*) 'q2', q2
      write(48,*) 't', t
      write(49,*) 'ucov', ucov
      write(50,*) 'vcov', vcov
      write(51,*) 'pext', pext
      write(52,*) 'co2ice', co2ice
      write(53,*) 'h', h
      write(54,*) 'phisold_newgrid', phisold_newgrid



      return
      end