c======================================================================= *=*=*=*= start2archive.html =*=*=*=*
PROGRAM start2archive

PROGRAM start2archive


      PROGRAM	start2archive
c=======================================================================
c
c
c   Date:    01/1997
c   ----
c
c
c   Objet:   Passage des  fichiers drs d'etat initial "start" et
c   -----    "startfi" a un fichier drs unique "start_archive"
c            (rendu visible sous grads par dic2ctl)
c
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 "drsdef.h"
#include "description.h"

#include "../phymars/dimphys.h"

c-----------------------------------------------------------------------
c   Declarations
c-----------------------------------------------------------------------

c variables dynamiques du GCM
c -----------------------------
      REAL	vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
      REAL	h(ip1jmp1,llm)                    ! temperature potentielle
      REAL	q(ip1jmp1,llm,nqmx)               ! champs advectes
      REAL	pext(ip1jmp1)                     ! pression extensive
      REAL	pks(ip1jmp1),pksf(ip1jmp1)        ! exner (f pour filtre)
      REAL	phis(ip1jmp1)                     ! geopotentiel au sol

c Variable Physiques (grille physique)
c ------------------------------------
      REAL	tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx)
      REAL	q2(ngridmx,nlayermx+1)
      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	ps(ip1jmp1),T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
      REAL	tsurfS(ip1jmp1),tsoilS(ip1jmp1,nsoilmx),co2iceS(ip1jmp1)
      REAL	q2S(ip1jmp1,llm+1)
      REAL	emisS(ip1jmp1)

c Variables intermediaires : vent naturel, mais pas coord scalaire
c----------------------------------------------------------------
      REAL	vn(ip1jm,llm),un(ip1jmp1,llm)

c Fonctions DRS:
c--------------
      INTEGER	setname, cluvdb, getdat,aslun,ierr,putvdim	

c Autres  variables
c -----------------
      LOGICAL	startdrs

      REAL	ptotal, co2icetotal
      REAL	date

      CHARACTER*2	str2
      CHARACTER*80 fichier	
      data		fichier /'startfi'/

      INTEGER	ij, l,i,j,isoil
      INTEGER	unit
      INTEGER	it1, it2

c-----------------------------------------------------------------------
c  	Initialisations
c-----------------------------------------------------------------------

      grireg   = .TRUE.
      startdrs = .TRUE.

c=======================================================================
c	Lecture des donnees
c=======================================================================

      call lectba(startdrs,nqmx,vcov,ucov,h,q,pext,phis,timedyn)
      call readfi(fichier,0,0,ngridmx,nsoilmx,startdrs,
     .      day_ini_fi,timefi,co2ice,tsurf,tsoil,emis,q2)

c-----------------------------------------------------------------------
c	Controle de la synchro
c-----------------------------------------------------------------------
      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10))
     &  stop ' Probleme de Synchro entre start et startfi !!!'

c-----------------------------------------------------------------------
c	Stockage de "tab_cntrl_fi" (tableau des param physiques)
c-----------------------------------------------------------------------

      do i=1,length
         tab_cntrl_fi(i)=0.
      enddo

c On relit specialement le tableau des parametres de startfi
      start = 94 ! On doit reouvrir startfi
      ierr = aslun(start,'startfi.dic',
     .             start+1,'startfi.dat',IDRS_READ)
      ierr = CLUVDB()
      ierr = SETNAME(' ','controle',' ',' ',' ')
      ierr = GETDAT(start, tab_cntrl_fi, IDRS_BYTES_PER_WORD*length)

c-----------------------------------------------------------------------
c  	Initialisations
c-----------------------------------------------------------------------

      call iniconst
      call inigeom
      call inifilr
      call exner(ip1jmp1,pext,aire,pks,pksf)

c=======================================================================
c	Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si ncessaire
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	Pression		(depend de la resolution horizontale)
c-----------------------------------------------------------------------
c
c	pext --> ps
c
c-----------------------------------------------------------------------

      call multipl(ip1jmp1,pext,unsaire,ps)

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) = h(ij,l)*pks(ij)*s(l) / cpp
         ENDDO
      ENDDO

c-----------------------------------------------------------------------
c	Variable physique
c-----------------------------------------------------------------------
c
c	tsurf --> tsurfS
c	co2ice --> co2iceS
c	tsoil --> tsoilS
c	emis --> emisS
c	q2 --> q2S
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)
      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)

c=======================================================================
c	Info pour controler
c=======================================================================

      ptotal =  0.
      co2icetotal = 0.
      DO j=1,jjp1
         DO i=1,iim
            ptotal=ptotal+pext(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=======================================================================

      unit = 44

c-----------------------------------------------------------------------
c	Ouverture de "start_archive"	
c-----------------------------------------------------------------------

      ierr = aslun(unit,'start_archive.dic',
     .				unit+1,'start_archive.dat',IDRS_EXTEND)

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.IDRS_SUCCESS) then
      	ierr = aslun(unit,'start_archive.dic',
     .				unit+1,'start_archive.dat',IDRS_CREATE)
      	call ini_archive(unit,.true.,day_ini,phis,tab_cntrl_fi)
      endif

c-----------------------------------------------------------------------
c	Ecriture de la coordonnee temps (date en jours)
c-----------------------------------------------------------------------

      date = day_ini
c     date = 0.

      ierr = cluvdb()
      ierr = setname(' ','temps','temps simule','jours',' ')
      ierr = putvdim(unit,1,date,it1,it2)
      write(6,*)' WRITEDEM: it1, it2, ',it1 ,it2

c-----------------------------------------------------------------------
c	Ecriture des champs 	(co2ice,emis,ps,Tsurf,T,u,v,q2)
c-----------------------------------------------------------------------
c	ATTENTION:	q2 a une couche de plus!!!!
c				Pour creer un fichier DRS 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(unit,'co2ice','couche de glace co2',
     &  'kg/m2',2,co2iceS,date)
      call write_archive(unit,'emis','grd emis',' ',2,emisS,date)
      call write_archive(unit,'ps','Psurf','Pa',2,ps,date)
      call write_archive(unit,'Tsurf','Surf T','K',2,tsurfS,date)
      call write_archive(unit,'T','Temperature','K',3,t,date)
      call write_archive(unit,'u','Vent zonal','m.s-1',3,us,date)
      call write_archive(unit,'v','Vent merid','m.s-1',3,vs,date)
      call write_archive(unit,'q2surf','wind variance','m2.s-2',2,
     .              q2S,date)
      call write_archive(unit,'q2atm','wind variance','m2.s-2',3,
     .              q2S(1,2),date)

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]

      do isoil=1,nsoilmx
      	write(str2,'(i2.2)') isoil
      	call write_archive(unit,'Tg'//str2,'Ground Temperature ','K',
     .			2,tsoilS(1,isoil),date)
      enddo

c-----------------------------------------------------------------------
c	Fin	
c-----------------------------------------------------------------------

      end