*=*=*=*= inimars.html =*=*=*=*
PROGRAM inimars IMPLICIT NONE c======================================================================= c c creation d'un etat initial pour le GCM martien c (fichiers DRS start et startfi) c c======================================================================= c c----------------------------------------------------------------------- c declarations: c ------------- #include "dimensions.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" c---------------------------- #include "../phymars/dimphys.h" c----------------------------- c REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) REAL h(iip1,jjp1,llm),pext(iip1,jjp1) REAL pks(iip1,jjp1),pksf(iip1,jjp1) REAL phis(iip1,jjp1) REAL w(iip1,jjp1,llm+1) REAL q(iip1,jjp1,llm,nqmx) ! champs advectes INTEGER iq REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) REAL dv(ip1jm,llm),du(ip1jmp1,llm) REAL dh(ip1jmp1,llm),dp(ip1jmp1) REAL z_reel(iip1,jjp1) REAL phisfi(ngridmx),rnaturfi(ngridmx) REAL alb(iip1,jjp1),albfi(ngridmx) REAL ith(iip1,jjp1),ithfi(ngridmx) REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx) REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx) c INTEGER i,j,l,ig,idum INTEGER*4 day0 INTEGER unit REAL p(iip1,jjp1),zz,xx REAL t(iip1,jjp1,llm) REAL phi(iip1,jjp1,llm) REAL pressrf REAL year_day,periheli,aphelie,peri_day REAL obliquit,z0,emin_turb,lmixmin REAL emissiv,emisice(2),albedice(2),tauvis,tauir,scatalb,asfact REAL href(llm),pref(llm),phiref(llm),pksref,pfact REAL airtot INTEGER ijmin,imin,jmin EXTERNAL RAN1 REAL RAN1 EXTERNAL iniconst,geopot,inigeom INTEGER aslun, cllun INTEGER ierr, nbetat INTEGER ISMIN,lnblnk external ISMIN LOGICAL startdrs CHARACTER*80 file, datapath c c ********************************************************************* c Valeurs des variables parametre du GCM martien c ********************************************************************* c Pression de reference sur la planete c ------------------------------------ pressrf = 651.245 ! Pression de reference (Pa) ~650 c Info sur la Planete Mars pour la dynamique et la physique 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 kappa=.256793 ! = r/cp ~0.256793 c Info sur la Planete Mars pour la physique uniquement c ---------------------------------------------------- year_day = 668.6 ! duree de l'annee (sols) ~668.6 periheli = 206.66 ! dist.min. soleil-mars (Mkm) ~206.66 aphelie = 249.22 ! dist.llm. soleil-mars (Mkm) ~249.22 peri_day = 485. ! date du perihelie (sols depuis printemps) obliquit = 23.98 ! Obliquite de la planete (deg) ~23.98 c 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=.95 ! Emissivite du sol martien ~.95 emisice(1)=0.53 ! Emissivite calotte nord emisice(2)=0.66 ! Emissivite calotte sud albedice(1)=0.58 ! Albedo calotte nord albedice(2)=0.41 ! Albedo calotte sud c Proprietes des poussiere aerosol c -------------------------------- tauvis= 0.2 ! profondeur optique visible moyenne tauir=0.2 !ratio (mean IR opt.depth)/visible scatalb=.86 ! scaterring albedo visible (~.86) asfact=.79 ! assymetrie factor visible (~.79) c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...) c ------------------------------------------------------------------------- datapath = '/dw/chourdin/MARS/data_mars' c ********************************************************************* c Main program c ********************************************************************* c Initialisations diverses c ------------------------ day_step=180 startdrs=.true. c OPEN(99,file='run.def',status='old',form='formatted') c CALL defrun(99) c CLOSE (99) CALL defrun_new( .FALSE. ) CALL iniconst CALL inigeom c write (*,*) 'ds main 1, cu=', cu ! INFO c write (*,*) 'ds main 1, aire =', aire ! INFO PRINT*,'dtvr ',dtvr idum=-1 xx=RAN1(idum) idum=0 c Initialition coordonnees /aires c ------------------------------- 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 de la topographie c ---------------------------------- c creation du fichier des altitudes. file=datapath(1:lnblnk(datapath))//'/relief.lmd' CALL initial0(ip1jmp1,z_reel) CALL dataread(file,z_reel) c CALL uniplot(iip1,jjp1,z_reel) DO j=1,jjp1 DO i=1,iip1 z_reel(i,j)=1000.*z_reel(i,j) ENDDO WRITE(6,'(64i1)') (NINT(10.*z_reel(i,j)),i=1,iip1) ENDDO C CALL uniplot(iip1,jjp1,z_reel) CALL dump2d(iip1,jjp1,z_reel,'Altitude en m') CALL multscal(ip1jmp1,z_reel,g,phis) CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi) c lecture de l'albedo c ------------------- file=datapath(1:lnblnk(datapath))//'/albedo.lmd' CALL dataread(file,alb) CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi) c lecture de l'inertie thermique c ------------------------------ file=datapath(1:lnblnk(datapath))//'/thermal.lmd' CALL dataread(file,ith) CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi) c Temperature de surface, Glace CO2 c --------------------------------- DO ig=1,ngridmx tsurf(ig)=200. co2ice(ig)=0. ENDDo c Temperature du sous-sol c -------------------------- DO l=1,nsoilmx DO ig=1,ngridmx tsoil(ig,l)=tsurf(ig) ENDDO ENDDO c Initialisation de la physique / ecriture de startfi : c --------------------------------------------------- CALL ini_fi(ngridmx,llm,startdrs, $ 0.,0.,daysec, 0,0., $ latfi,lonfi,airefi,phisfi,rnaturfi, $ albfi,ithfi, $ rad,g,r,cpp,mugaz,omeg,tsurf,tsoil,co2ice, $ year_day,periheli,aphelie,peri_day, $ obliquit,z0,emin_turb,lmixmin, $ emissiv,emisice,albedice, $ tauvis,tauir,scatalb,asfact) c c Initialisation temperatures atmospheriques c ------------------------------------------ DO l=1,llm DO j=1,jjp1 DO i=1,iim t(i,j,l)=200. END DO END DO c DO j=2,jjm c DO i=1,iim c t(i,j,l)=t(i,j,l)+COS(rlatu(j))*(RAN1(idum)-0.5) c ENDDO c ENDDO DO j=1,jjp1 t(iip1,j,l)=t(1,j,l) END DO END DO c c CALCUL DE L'EQUILIBRE HYDROSTATIQUE GLOBAL (initialisation pext) c ----------------------------------------------------------------- c on commence par calculer le champ de pression pour une pression c au sol arbitraire 1mb ijmin=ISMIN(ip1jmp1,phis,1) jmin=(ijmin-1)/iip1+1 imin=ijmin-(jmin-1)*iip1 DO l=1,llm href(l)=t(imin,jmin,l)*cpp/s(l) pref(l)=s(l)**(1./kappa) ENDDO pksref=1. CALL geopot(1,href,pksref,phis(imin,jmin),phiref) DO j=1,jjp1 DO i=1,iim CALL interpol(phiref,pref,llm,phis(i,j),p(i,j),1) ENDDO ENDDO c p(imin,jmin)=1. DO j=1,jjp1 DO i=1,iim pext(i,j)=p(i,j)*aire(i,j) ENDDO ENDDO airtot=0. ptot=0. DO j=1,jjp1 DO i=1,iim airtot=airtot+aire(i,j) ptot=ptot+pext(i,j) ENDDO ENDDO pfact=pressrf*airtot/ptot CALL multscal(ip1jmp1,pext,pfact,pext) CALL SCOPY(jjp1,pext,iip1,pext(iip1,1),iip1) CALL multipl(ip1jmp1,pext,unsaire,p) c CALL uniplot(iip1,jjp1,p) CALL dump2d(iip1,jjp1,p,'pression naturelle au sol') PRINT*,imin,jmin c----------------------------------------------------------------------- c Initialisation h,pks,pksf,pext: c ------------------------------- c DO l=1,llm DO j=1,jjp1 DO i=1,iip1 h(i,j,l) = t(i,j,l)*cpp/(s(l)*p(i,j)**kappa) ENDDO ENDDO ENDDO c DO j=1,jjp1 DO i=1,iip1 pks(i,j) =p(i,j)**kappa pksf(i,j)=pks(i,j) ENDDO ENDDO c c----------------------------------------------------------------------- c calcul des champ de vent: c ------------------------- c DO l=1,llm DO i=1,iip1 ucov(i,1,l)=0. ucov(i,jjp1,l)=0. ENDDO DO j=2,jjm DO i=1,iim ucov(i,j,l) = 0. ENDDO ucov(iip1,j,l)=ucov(1,j,l) ENDDO ENDDO c DO l=1,llm DO j=1,jjm DO i=1,iim vcov(i,j,l) = 0. ENDDO vcov(iip1,j,l)=vcov(1,j,l) ENDDO ENDDO c---------------------------------------------------------- c Initialisation des champ de traceur: c --------------------------- DO iq =1, nqmx DO l=1,llm DO j=1,jjp1 DO i=1,iim q(i,j,l,iq)=0. ENDDO ENDDO ENDDO ENDDO c----------------------------------------------------------------------- c ecriture du fichier de demarage: start c -------------------------------------- c CALL inifilr CALL exner(ip1jmp1,pext,aire,pks,pksf) CALL geopot (ip1jmp1, h , pks , phis , phi ) CALL caldyn $ (0,ucov,vcov,h,pext,pks,pksf,phis, $ phi,.true.,du,dv,dh,dp,w, pbaru,pbarv,0.) PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang' PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang c----------------------------------------------------------------------- unit=12 IF(startdrs) THEN ierr = aslun(unit,'start.dic', . unit+1,'start.dat',IDRS_CREATE) ELSE OPEN(unit,file='start',form='unformatted',status='new', . iostat=ierr) ENDIF if (ierr.ne.0) then write(6,*)' Pb de creation du fichier start. Existe deja ?' write(6,*)' ierr = ', ierr call exit(1) endif day0=0 CALL iniwrite(unit,startdrs,day0,phis) zz=0. call WRITEDEM(unit,nqmx,startdrs,zz,vcov,ucov,h,q,pext, . phis,nbetat) ierr = cllun(unit) end