*=*=*=*= newgridmars2.html =*=*=*=*
PROGRAM newgridmars2 IMPLICIT NONE c======================================================================= c c creation d'un etat initial pour le GCM martien c (fichiers DRS start et startfi) c A partir d'un start obtenu avec une autre grille c c (ce programme est a compiler dans la NOUVELLE grille) c c Il faut avoir lancer newgridmars1 auparavant c----------------------------------- ------------------------------------- c c ------------------------------------- c DIMENSION DE L'ANCIENNE GRILLE INTEGER imold,jmold,lmold PARAMETER (imold= 32,jmold=24,lmold=15) c ------------------------------------- c c declarations: c ------------- 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" #include "temps.h" c ---------------------------- #include "../phymars/dimphys.h" c----------------------------- c Variable histoire : REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants REAL h(iip1,jjp1,llm),pext(iip1,jjp1) REAL phis(iip1,jjp1) REAL q(iip1,jjp1,llm,nqmx) ! champs advectes c autre variables dynamique nouvelle grille REAL pks(iip1,jjp1),pksf(iip1,jjp1) REAL w(iip1,jjp1,llm+1) 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 phi(iip1,jjp1,llm) c variable physique REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx) REAL phisfi(ngridmx),rnaturfi(ngridmx) REAL alb(iip1,jjp1),albfi(ngridmx) REAL ith(iip1,jjp1),ithfi(ngridmx) REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx) c INTEGER i,j,l,idum INTEGER unit REAL xx REAL year_day,periheli,aphelie,peri_day REAL obliquit,z0,emin_turb,lmixmin REAL emissiv,emisice(2),albedice(2),tauvis,tauir,scatalb,asfact 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 Variable nouvelle grille naturelle au point scalaire REAL us(iip1,jjp1,llm),vs(iip1,jjp1,llm) REAL p(iip1,jjp1) REAL t(iip1,jjp1,llm) REAL tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx) REAL co2iceS(iip1,jjp1) REAL ptotal, co2icetotal c Var intermediaires : vent naturel, mais pas coord scalaire REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm) c Variable de l'ancienne grille (lu dans newgridmars.data) REAL rlonuold(imold+1), rlatvold(jmold) REAL sigold(lmold+1),sold(lmold),sig_sold(lmold) REAL time REAL uold(imold+1,jmold+1,lmold) REAL vold(imold+1,jmold+1,lmold) REAL Told(imold+1,jmold+1,lmold) REAL PSold(imold+1,jmold+1) REAL phisold(imold+1,jmold+1) REAL tab_cntrl(100) REAL co2iceold(imold+1,jmold+1) REAL tsurfold(imold+1,jmold+1) REAL tsoilold(imold+1,jmold+1,nsoilmx) REAL ptotalold, co2icetotalold c Variable intermediaires iutilise pour l'extrapolation verticale REAL var (imold+1,jmold+1,llm) c variable intermediaire pour l'extrapolation de la pression de surface REAL pseaold(imold+1,jmold+1), Rgaz REAL psea(iip1,jjp1) c ********************************************************************* c Lecture des variables de l'ancienne grille, c (elles sont toutes dans la grille scalaire) c ******************************************************************** open (23,file = 'newgridmars.data',status ='old', & form='unformatted') c Variable de start (des info du "controle" sont ds le controle de startfi) read (23) rlonuold,rlatvold,sigold,sold, sig_sold,time, & uold,vold,told,psold,phisold, kappa & ,ang0,etot0,ptot0,ztot0,stot0 c variable de startfi read (23) tab_cntrl,co2iceold,tsurfold,tsoilold c Variable de controle read(23) ptotalold, co2icetotalold close (23) c ********************************************************************* c reinitialisation des variables parametre du GCM martien c ********************************************************************* c gestion du temps c ---------------- day_ini=tab_cntrl(3) c Info sur la Planete Mars pour la dynamique et la physique c --------------------------------------------------------- rad= tab_cntrl(5) ! rayon de mars (m) ~3397200 m daysec= tab_cntrl(10) ! duree du sol (s) ~88775 s omeg=tab_cntrl(6) ! vitesse de rotation (rad.s-1) g= tab_cntrl(7) ! gravite (m.s-2) ~3.72 mugaz= tab_cntrl(8) ! Masse molaire de l'atm (g.mol-1) ~43.49 c kappa = (deja lu dans 'newgridmars.data') c Info sur la Planete Mars pour la physique uniquement c ---------------------------------------------------- year_day = tab_cntrl(14) ! duree de l'annee (sols) ~668.6 periheli = tab_cntrl(15) ! dist.min. soleil-mars (Mkm) ~206.66 aphelie = tab_cntrl(16) ! dist.llm. soleil-mars (Mkm) ~249.22 peri_day = tab_cntrl(17) ! date du perihelie (sols depuis printemps) obliquit = tab_cntrl(18) ! Obliquite de la planete (deg) ~23.98 c Couche limite et Turbulence c --------------------------- z0 = tab_cntrl(19) ! surface roughness (m) ~0.01 emin_turb = tab_cntrl(21) ! energie minimale ~1.e-8 lmixmin = tab_cntrl(20) ! longueur de melange ~100 c propriete optiques des calottes et emissivite du sol c ---------------------------------------------------- emissiv= tab_cntrl(26) ! Emissivite du sol martien ~.95 emisice(1)= tab_cntrl(24) ! Emissivite calotte nord emisice(2)=tab_cntrl(25) ! Emissivite calotte sud albedice(1)= tab_cntrl(22) ! Albedo calotte nord albedice(2)= tab_cntrl(23) ! Albedo calotte sud c Proprietes des poussiere aerosol c -------------------------------- tauvis=tab_cntrl(27) ! profondeur optique visible moyenne tauir=tab_cntrl(30) !ratio (visible opt.depth)/(mean IR opt.depth) scatalb= tab_cntrl(28) ! scaterring albedo visible (~.86) asfact= tab_cntrl(29) ! assymetrie factor visible (~.79) c c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...) c ------------------------------------------------------------------------- datapath = '/dw/chourdin/MARS/data_mars' c ********************************************************************* c INITIALISATIONS DIVERSES c ********************************************************************* c Initialisations diverses c ------------------------ day_step=180 startdrs=.true. OPEN(99,file='run.def',status='old',form='formatted') CALL defrun(99) CLOSE (99) CALL iniconst CALL inigeom idum=-1 xx=RAN1(idum) idum=0 c Initialisation 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) 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 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 *************************************************************** c INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables c ************************************************************** c Interpolation horizontale puis passage dans la grille physique pour c les variables physique c Interpolation verticale puis horizontale pour chaque variable 3D c Temperature de surface call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1, & rlonuold,rlatvold,rlonu,rlatv) call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tsurfs,tsurf) c Glace CO2 call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1, & rlonuold,rlatvold,rlonu,rlatv) call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,co2ices,co2ice) c Temperature du sous-sol call interp_horiz(tsoilold,tsoils, & imold,jmold,iim,jjm,nsoilmx, & rlonuold,rlatvold,rlonu,rlatv) call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoils,tsoil) c temperatures atmospheriques write (*,*) 'told ', told (1,jmold+1,1) ! INFO call interp_vert & (told,var,lmold,llm,sig_sold,sig_s,(imold+1)*(jmold+1)) write (*,*) 'var ', var (1,jmold+1,1) ! INFO call interp_horiz(var,t,imold,jmold,iim,jjm,llm, & rlonuold,rlatvold,rlonu,rlatv) write (*,*) 't ', t(1,jjp1,1) ! INFO c calcul des champ de vent; passage en vent covariant c write (*,*) 'uold ', uold (1,2,1) ! INFO call interp_vert & (uold,var,lmold,llm,sig_sold,sig_s,(imold+1)*(jmold+1)) c write (*,*) 'var ', var (1,2,1) ! INFO call interp_horiz(var,us,imold,jmold,iim,jjm,llm, & rlonuold,rlatvold,rlonu,rlatv) c write (*,*) 'us ', us (1,2,1) ! INFO call interp_vert & (vold,var,lmold,llm,sig_sold,sig_s,(imold+1)*(jmold+1)) call interp_horiz(var,vs,imold,jmold,iim,jjm,llm, & rlonuold,rlatvold,rlonu,rlatv) call scal_wind(us,vs,unat,vnat) c write (*,*) 'unat ', unat (1,2,1) ! INFO do l=1,llm do j = 1, jjp1 do i=1,iip1 ucov( i,j,l ) = unat( i,j,l ) * cu(i,j) end do end do end do c write (*,*) 'ucov ', ucov (1,2,1) ! INFO do l=1,llm do j = 1, jjm do i=1,iip1 vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j) end do end do end do c------------------------------------------------ c Traitement special de la pression au sol : c ------------------------------------------------------------------- c Calcul de la pression "au niveau de la mer" z = 0 dns l'ancienne grille Rgaz = 1000.*8.31/mugaz DO j=1,jmold+1 DO i=1,imold+1 pseaold(i,j)=psold(i,j)*EXP(phisold(i,j)/(Told(i,j,1)*Rgaz)) ENDDO ENDDO c Test TestTest Test Test Test Test Test Test Test Test write (*,*)'pour i=9, j=9 pseaold,psold,phisold,told,Rgaz' write(*,*) pseaold(9,9),psold(9,9),phisold(9,9),told(9,9,1),Rgaz c Extrapolation la pression "au niveau de la mer" z = 0 dns la nouvelle grille call interp_horiz(pseaold,psea,imold,jmold,iim,jjm,1, & rlonuold,rlatvold,rlonu,rlatv) c Calcul de la pression avec le relief de la nouvelle grille DO j=1,jjp1 DO i=1,iip1 p(i,j) = psea(i,j)*EXP(-phis(i,j)/(t(i,j,1)*Rgaz)) pext(i,j)=p(i,j)*aire(i,j) ENDDO ENDDO c ------------------------------------------------------------------- c On assure la concervation de la masse de l'atmosphere + calottes c ------------------------------------------------------------------- ptotal = 0. co2icetotal = 0. DO j=1,jjp1 DO i=1,iim ptotal=ptotal+pext(i,j)/g co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j) ENDDO ENDDO write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold DO j=1,jjp1 DO i=1,iip1 pext(i,j)=pext(i,j) * ptotalold/ptotal p(i,j)=p(i,j) * ptotalold/ptotal ENDDO ENDDO if ( co2icetotalold.ne.0.) then write(*,*)'Ratio new ice./old ice =',co2icetotalold/co2icetotalold DO j=1,jjp1 DO i=1,iip1 co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal ENDDO ENDDO end if c----------------------------------------------------------------------- c Initialisation h,pks,pksf: 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 Initialisation des champ de traceur: c --------------------------- DO iq =1, nqmx DO l=1,llm DO j=1,jjp1 DO i=1,iip1 q(i,j,l,iq)=0. ENDDO ENDDO ENDDO ENDDO c---------------------------------------------------------- c ********************************************************************* c Initialisation de la physique / ecriture de startfi : c ********************************************************************* CALL ini_fi(ngridmx,llm,startdrs, $ day_ini,time,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 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 CALL iniwrite(unit,startdrs,day_ini,phis) call WRITEDEM(unit,nqmx,startdrs,time,vcov,ucov,h,q,pext, . phis,nbetat) ierr = cllun(unit) c----------------------------------------------------------------------- c Info pour controler c ------------------- ptotal =0 co2icetotal = 0. DO j=1,jjp1 DO i=1,iim ptotal=ptotal+pext(i,j)/g co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j) ENDDO ENDDO write(*,*)'Ancienne grille: masse de l''atm :',ptotalold write(*,*)'Nouvelle grille: masse de l''atm :',ptotal write(*,*) write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal end