c======================================================================= *=*=*=*= ini_archive.html =*=*=*=*
subroutine ini_archive

subroutine ini_archive


      subroutine ini_archive(unit,ldrs,idayref,phis,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       unit           unite logique du fichier "start_archive"
c       ldrs           fichier DRS ou non
c       idayref        Valeur du jour initial a mettre dans
c                      l'entete du fichier "start_archive"
c       phis           geopotentiel au sol
c       tab_cntrl_fi   tableau des param physiques
c
c
c=======================================================================

      implicit none

#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 "drsdef.h"
#include "description.h"
#include "serre.h"

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
      INTEGER	unit
      LOGICAL	ldrs
      REAL		phis(ip1jmp1)
      REAL		tab_cntrl_fi(length)

c-----------------------------------------------------------------------
c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
c-----------------------------------------------------------------------

      DO l=1,length
         tab_cntrl(l)=0.
      ENDDO
      do loop = 1, llm
        sig_s(loop) = s(loop) ** (1./kappa)
      enddo

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c pour la DOCUMENTATION    (fichier io/verbatim/dyn_cntl)
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) = mugaz   ! 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) = clon   ! longitude en degres du centre du zoom
      tab_cntrl(18) = clat   ! latitude en degres du centre du zoom
      tab_cntrl(19) = alphax ! facteur de grossissement du zoom,selon longitude
      tab_cntrl(20) = alphay ! facteur de grossissement du zoom ,selon latitude
      tab_cntrl(21) = fxyhypb ! Fonction hyperbolique si T ou sinusoidale si F
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

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 DRS de l'entete du fichier "start_archive"
c=======================================================================

      IF(ldrs) THEN

c-----------------------------------------------------------------------
c  Ecriture DRS du tableau des parametres du run
c-----------------------------------------------------------------------

      ierr = CLUVDB()
      ierr = SETDIM(1,'index',' ',length,1.,float(length))
      ierr = SETNAME(descript,'controle','Tableau des parametres du run'
     .              ,' ',' ')
      ierr = PUTDAT(unit,tab_cntrl)

c-----------------------------------------------------------------------
c  Ecriture des longitudes et latitudes
c-----------------------------------------------------------------------

      ierr = SETNAME(descript,'rlonu','Longitudes aux points u',
     .               'radians',' ')
      ierr = PUTVDIM(unit,iip1,rlonu,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast
      ierr = SETNAME(descript,'rlatu','Latitudes aux points u',
     .               'radians',' ')
      ierr = PUTVDIM(unit,jjp1,rlatu,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast
      ierr = SETNAME(descript,'rlonv','Longitudes aux points v',
     .               'radians',' ')
      ierr = PUTVDIM(unit,iip1,rlonv,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast
      ierr = SETNAME(descript,'rlatv','Latitudes aux points v',
     .               'radians',' ')
      ierr = PUTVDIM(unit,jjm,rlatv,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast

c-----------------------------------------------------------------------
c  Ecriture des niveaux verticaux
c-----------------------------------------------------------------------

      ierr = SETNAME(descript,'sig','Niveaux sigmas',
     .               ' ',' ')
      ierr = PUTVDIM(unit,llm+1,sig,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast
      ierr = SETNAME(descript,'s','Niveaux s',
     .               ' ',' ')
      ierr = PUTVDIM(unit,llm,s,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast
      ierr = SETNAME(descript,'sig_s','sigmas aux niveaux s',
     .               ' ',' ')
      ierr = PUTVDIM(unit,llm,sig_s,ind1,indlast)
      write(6,*)' INIECRIBA: ind1,indlast ',ind1,indlast

c-----------------------------------------------------------------------
c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
c-----------------------------------------------------------------------

      ierr = CLUVDB()
      ierr = SETVDIM(1,' ','rlonu',' ',' ',rlonu(1),rlonu(iip1))
      ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
      ierr = SETNAME(descript,'cu',
     .   'Coefficients de passage cov <--> naturel',' ',' ')
      ierr = PUTDAT(unit,cu)
      ierr = CLUVDB()
      ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
      ierr = SETVDIM(2,' ','rlatv',' ',' ',rlatv(1),rlatv(jjm))
      ierr = SETNAME(descript,'cv',
     .   'Coefficients de passage cov <--> naturel',' ',' ')
      ierr = PUTDAT(unit,cv)
      ierr = CLUVDB()
      ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
      ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
      ierr = SETNAME(descript,'aire','Aires des mailles',
     .               ' ',' ')
      ierr = PUTDAT(unit,aire)

c-----------------------------------------------------------------------
c  Ecriture du geopentiel au sol
c-----------------------------------------------------------------------

      ierr = CLUVDB()
      ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
      ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
      ierr = SETNAME(descript,'phisinit','Geopotentiel au sol init',
     .               'm2/s2',' ')
      ierr = PUTDAT(unit,phis)

c-----------------------------------------------------------------------
c  Sinon (ldrs)
c-----------------------------------------------------------------------

      ELSE

         WRITE(unit) tab_cntrl
         WRITE(unit) rlonu,rlatu,rlonv,rlatv,sig,s,sig_s,cu,cv,aire
         WRITE(unit) phis

      ENDIF

      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
      PRINT*,'rad,omeg,g,mugaz,kappa',
     s rad,omeg,g,mugaz,kappa
      PRINT*,'daysec,dtvr',daysec,dtvr

      RETURN
      END