c=======================================================================
*=*=*=*= create_start_archive.html =*=*=*=*
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