*=*=*=*= testphys1d.html =*=*=*=*
PROGRAM testphys1d IMPLICIT NONE c subject: c -------- c PROGRAM useful to run physical part of the martian GCM in a 1D column c to run it : tesphys1d.e < tesphys1d.def c c author: Frederic Hourdin, R.Fournier,F.Forget c ------- #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" #include "comgeomfi.h" #include "surfdat.h" #include "comdiurn.h" #include "callkeys.h" #include "comcstfi.h" #include "planete.h" #include "comsaison.h" #include "yomaer.h" #include "aerdata.h" #include "control.h" #include "comvert.h" #include "drsdef.h" #include "comg1d.h" c....................................................................... c declarations c INTEGER unit,aslun,ierr LOGICAL ldrs c INTEGER day0 REAL ptif,gru,grv c INTEGER nlayer,nlevel,nsoil,ndt INTEGER ilayer,ilevel,isoil,idt SAVE idt LOGICAl firstcall,lastcall c REAL pks REAL phi(nlayermx),h(nlayermx) REAL zlay(nlayermx),play(nlayermx),plev(nlayermx+1) INTEGER day REAL time REAL psurf,tsurf REAL dpsurf REAL u(nlayermx),v(nlayermx),w(nlayermx),temp(nlayermx) REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx) REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx) REAL q(nlayermx,nqmx) REAL dq(nlayermx,nqmx) REAL dqdyn(nlayermx,nqmx) REAL tsoil(nsoilmx) REAL co2ice,emis REAL q2(nlayermx+1) c c declarations c....................................................................... c bidouilles c c REAL temporaire(nlayermx) c REAL thaut,tbas c CHARACTER*100 spectre c REAL fab(nlayermx+1),fdb(nlayermx+1) REAL tmp1(0:nlayermx),tmp2(0:nlayermx) c c bidouilles c....................................................................... c chargement des constantes c pi=2.E+0*asin(1.E+0) c c Pression de reference sur la planete c ------------------------------------ c PRINT *,'pression au sol' READ(5,*) psurf c c Info sur la Planete Mars pour la dynamique et la physique c --------------------------------------------------------- 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 rcp=.256793 ! = r/cp ~0.256793 r= 8.314511E+0 *1000.E+0/mugaz cpp= r/rcp c c Info sur la Planete Mars pour la physique uniquement c ---------------------------------------------------- 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.max. 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 c Couche limite et Turbulence c --------------------------- 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 c propriete optiques des calottes et emissivite du sol c ---------------------------------------------------- c emissiv= 0.95 ! Emissivite du sol martien ~.95 emisice(1)=0.95 ! Emissivite calotte nord emisice(2)=0.95 ! Emissivite calotte sud albedice(1)=0.4 ! Albedo calotte nord albedice(2)=0.4 ! Albedo calotte sud iceradius(1) = 100.e-6 ! mean scat radius of CO2 snow (north) iceradius(2) = 100.e-6 ! mean scat radius of CO2 snow (south) dtemisice(1) = 2. ! time scale for snow metamorphism (north) dtemisice(2) = 2. ! time scale for snow metamorphism (south c c Proprietes des poussiere aerosol c -------------------------------- c tauvis= 0. ! profondeur optique visible moyenne PRINT *,'epaisseur optique dans le visibile ?' READ(5,*) tauvis c c Date (en jour depuis le solstice de printemps) du debut du run c -------------------------------------------------------------- c day0 = 0 PRINT *,'date de depart ?' READ(5,*) day0 c c declinaison c ----------- c declin=-24.8E+0 declin=declin*pi/180.E+0 c c distance soleil c --------------- c dist_sol=1.4E+0 c c albedo / inertie du sol c ----------------------- c albedodat(1)=0.24E+0 inertiedat(1)=400.E+0 c c latitude/longitude c ------------------ c PRINT *,'latitude en degres ?' READ(5,*) lati(1) lati(1)=lati(1)*pi/180.E+0 long(1)=0.E+0 long(1)=long(1)*pi/180.E+0 c c pour le schema d'ondes de gravite c --------------------------------- c zmea(1)=0.E+0 zstd(1)=0.E+0 zsig(1)=0.E+0 zgam(1)=0.E+0 zthe(1)=0.E+0 c c chargement des constantes c....................................................................... c la discretisation c nlayer=nlayermx nlevel=nlayer+1 nsoil=nsoilmx PRINT *,'nombre de pas de temps par jour ?' READ(5,*) day_step PRINT *,'nombre de jours simules ?' READ(5,*) ndt c chris fixe a un seul pas de temps c ndt=ndt*day_step c ndt=5 dtphys=daysec/day_step c c la discretisation c....................................................................... c "inifis" reproduit un certain nombre d'initialisations deja faites c c + lecture des clefs de callphys.def c + calcul de la frequence d'appel au rayonnement c + calcul des sinus et cosinus des longitude latitude c c NOTE : c la surface de chaque maille est inutile en 1D ---> area(1)=1.E+0 c call inifis(1,nlayermx, & daysec, & day0,dtphys, & lati,long,area, & rad,g,r,cpp) c c....................................................................... c les constantes pour le 1D c ptif=2.E+0*omeg*sinlat(1) c c vent geostrophique c PRINT *,'composante vers l est du vent geostrophique (U) ?' READ(5,*) gru PRINT *,'composante vers le nord du vent geostrophique (V) ?' READ(5,*) grv c c les constantes pour le 1D c....................................................................... c initialisations c c debut c ----- c day=day0 PRINT *,'heure de debut de simulation (entre 0 et 24) ?' READ(5,*) time time=time/24.E+0 c********************************************************************* c calcul des pressions et altitudes en utilisant les niveaux sigma c ---------------------------------------------------------------- c CALL disvert(nlayer,rcp,sig,dsig,s,ds,dsig1,sdsig) DO ilayer=1,nlayer sig_s(ilayer)=0.5*(sig(ilayer)+sig(ilayer+1)) s(ilayer)=sig_s(ilayer)**(1.E+0*rcp) ENDDO DO ilevel=1,nlevel plev(ilevel)=psurf*sig(ilevel) ENDDO DO ilayer=1,nlayer play(ilayer)=psurf*sig_s(ilayer) ENDDO DO ilayer=1,nlayer zlay(ilayer)=-200.E+0 *r*log(s(ilayer)) & /(1000.E+0 *g*rcp) ENDDO c do ilayer = 1, nlayermx c print*,ilayer,sig(ilayer) c enddo c print*,nlayermx+1,sig(nlayermx+1) c********************************************************************* c profil de temperature au premier appel c -------------------------------------- c pks=psurf**rcp tmp1(0)=0.E+0 DO ilayer=1,nlayer tmp1(ilayer)=zlay(ilayer) ENDDO call profile(nlayer+1,tmp1,tmp2) tsurf=tmp2(0) DO ilayer=1,nlayer temp(ilayer)=tmp2(ilayer) ENDDO c print*,0,' tsurf apres call profile',tsurf c DO ilayer=1,nlayer c print*,ilayer,' temp apres call profile',temp(ilayer) c ENDDO c le profil de temperature lineaire en pression. c si le rapport de melange des poussieres est independant de c la pression (voir dans PHYSIQ.F), on se retrouve avec une c configuration ou le profil de temperature est lineaire en c fonction de l'epaisseur optique --> c tsurf=215.E+0 c tbas=tsurf-20.E+0 c thaut=130.E+0 c DO ilayer=1,nlayer c temp(ilayer)=play(ilayer)/psurf*(tbas-thaut) + thaut c ENDDO c c enthalpie potentielle c DO ilayer=1,nlayer h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer)) ENDDO phi(1)=pks*h(1)*(1.E+0-s(1)) DO ilayer=2,nlayer phi(ilayer)=phi(ilayer-1)+ & pks*(h(ilayer-1)+h(ilayer))*.5E+0 & *(s(ilayer-1)-s(ilayer)) ENDDO c c temperature du sous-sol c ----------------------- c DO isoil=1,nsoil tsoil(isoil)=tsurf ENDDO c c initialisation des vitesses au vent geostrophique c ------------------------------------------------- c DO ilayer=1,nlayer u(ilayer)=gru v(ilayer)=grv ENDDO c c glace de CO2 au sol c ------------------- c co2ice=0.E+0 PRINT *,'co2ice (kg.m-2)' READ(5,*) co2ice c c emissivite c ---------- c Chris lit dans testphys1d.def emissiv pour eviter de recompiler READ(5,*) emissiv ! Emissivite du sol martien ~.95 emisice(1) = emissiv ! Emissivite calotte nord emisice(2) = emissiv ! Emissivite calotte sud emis=emissiv IF (co2ice.eq.1.E+0) THEN emis=emisice(1) IF(lati(1).LT.0) emis=emisice(2) ENDIF c c energie cinetique turbulente c ---------------------------- c DO ilevel=1,nlevel q2(ilevel)=0.E+0 ENDDO c initialisation pour GRADS-1D c ---------------------------- g1d_nlayer=nlayer g1d_nomfich='g1d.dat' g1d_unitfich=40 g1d_nomctl='g1d.ctl' g1d_unitctl=41 g1d_premier=.true. g2d_premier=.true. c....................................................................... c un calcul radiatif monochromatique de reference c c on fait un decoupage en nlayer couches de meme epaisseur optique. c l'epaisseur optique est donnee a 0.67 micron. c en sortie on recuppere les flux dans chacune des bandes de l'IR c (flux ascendant et flux descendant a l'interface des couches). c les numerotations sont dans l'ordre du GCM : du bas vers le c haut, "1" pour le sol et "nlayer+1" pour la limite haute. c c spectre='francois_ir.fic' c CALL radref(spectre,longrefir,tauvis*psurf/700.E+0/solsir c & ,tsurf,tbas,thaut,nlayer,fab,fdb) c c petite sortie pour gnuplot c open(155,file='temp.gnu',status='new') c open(156,file='masse.gnu',status='new') c open(157,file='ref.gnu',status='new') c write(156,*) nlevel c DO ilayer=1,nlayer c write(155,*) psurf-play(ilayer),temp(ilayer) c ENDDO c DO ilevel=1,nlevel c write(156,*) psurf-plev(ilevel) c write(157,*) psurf*REAL(ilevel-1)/REAL(nlevel-1) c & ,fab(ilevel),fdb(ilevel) c ENDDO c close(155) c close(156) c close(157) c c....................................................................... c ecriture de "startfi" c c NOTE : c le geopotentiel au sol est inutile en 1D car tout est controle c par la pression de surface ---> phisfi(1)=0.E+0 c unit=92 ldrs=.FALSE. IF (ldrs) THEN ierr = aslun(unit,'startfi.dic', & unit+1,'startfi',IDRS_CREATE) ELSE OPEN(unit,FILE='startfi',FORM='unformatted') ENDIF c CALL ini_fi(1,nlayer,unit,ldrs, $ day0,time,daysec,0.E+0,dtphys, $ lati,long,area,phisfi,1.E+0, $ albedodat,inertiedat, $ rad,g,r,cpp,mugaz,omeg,tsurf,tsoil,co2ice, $ year_day,periheli,aphelie,peri_day, $ obliquit,z0,emin_turb,lmixmin, $ emissiv,emisice,albedice, $ tauvis,0.E+0,0.E+0,0.E+0, $ emis,iceradius,dtemisice,q2, $ zmea,zstd,zsig,zgam,zthe) c CLOSE(unit) c c ecriture de "startfi" c....................................................................... c iteration dans le temps c firstcall=.true. lastcall=.false. DO idt=1,ndt IF (idt.eq.ndt) lastcall=.true. c....................................................................... c appel de la physique c CALL physiq(1.E+0,1,nlayer,nqmx, $ firstcall,lastcall, $ day,time,dtphys, $ plev,play,phi, $ u,v,temp,q, $ dudyn,dvdyn,dtempdyn,dqdyn, $ w, $ du,dv,dtemp,dq,dpsurf) c c....................................................................... c evolution du vent : modele 1D c c la physique calcule les derivees temporelles de u et v. c on y rajoute betement un effet Coriolis. c DO ilayer=1,nlayer du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv) dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru) ENDDO c Pour certain test : if(lati(1).eq.0.) then DO ilayer=1,nlayer du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4 dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4 ENDDO end if c c....................................................................... c calcul des vitesses et temperature au pas de temps suivant c firstcall=.false. time=time+dtphys/daysec IF (time.gt.1.E+0) then time=time-1.E+0 day=day+1 ENDIF c print*,'temp1 lecture exterieure', temp DO ilayer=1,nlayer u(ilayer)=u(ilayer)+dtphys*du(ilayer) v(ilayer)=v(ilayer)+dtphys*dv(ilayer) temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer) ENDDO c print*,'temp2 lecture exterieure', temp c WRITE (78,*) time*24,acos(mu0(1))*180/pi c....................................................................... c iteration dans le temps c ENDDO c c fermeture pour GRADS-1D c ---------------------------- CALL endg1d(1,nlayer,zlay,ndt) ENDc c....................................................................... c *=*=*=*= gr_fi_dyn.html =*=*=*=*
subroutine gr_fi_dyn RETURN ENDc c....................................................................... c *=*=*=*= iniwrite.html =*=*=*=*
subroutine iniwrite RETURN ENDc c....................................................................... c *=*=*=*= disvert.html =*=*=*=*
SUBROUTINE disvert(llm,kappa,sig,dsig,s,ds,dsig1,sdsig) IMPLICIT NONE c c======================================================================= c c c s = sigma ** kappa : coordonnee verticale c dsig(l) : epaisseur de la couche l ds la coord. s c sig(l) : sigma a l'interface des couches l et l-1 c ds(l) : distance entre les couches l et l-1 en coord.s c c======================================================================= c c declarations: c ------------- c integer llm real kappa,pi,x real sig(llm+1),dsig(llm),s(llm),ds(llm),dsig1(llm),sdsig(llm) c integer ll,l,lllm,lllmm1,lllmp1 real quoi,quand,snorm,sigbid,sbid REAL alpha,beta,h,dz0,dz1 REAL gama,delta,deltaz,np real nhaut INTEGER ierr1,ierr2 real csig,esig,zz,sig1 REAL SSUM,z1,z2 EXTERNAL SSUM c c----------------------------------------------------------------------- c lllm=llm lllmm1=lllm-1 lllmp1=lllm+1 pi=2.*asin(1.) OPEN(99,file='sigma.def',status='old',form='formatted', s iostat=ierr1) if(ierr1.ne.0) then close(99) open(99,file='esasig.def',status='old',form='formatted', s iostat=ierr2) endif c----------------------------------------------------------------------- c cas 1 on lit les options dans sigma.def: c ---------------------------------------- if (ierr1.eq.0) then READ(99,*) deltaz READ(99,*) h READ(99,*) beta READ(99,*) gama READ(99,*) delta READ(99,*) np CLOSE(99) alpha=deltaz/(llm*h) do l= 1, llm dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))* $ ( (tanh(gama*l)/tanh(gama*llm))**np + $ (1.-l/FLOAT(llm))*delta ) enddo sig(1)=1. do l=1,llm-1 sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l)) enddo sig(llm+1)=0. do l = 1, llm dsig(l) = sig(l)-sig(l+1) enddo else if(ierr2.eq.0) then READ(99,*) h READ(99,*) dz0 READ(99,*) dz1 READ(99,*) nhaut CLOSE(99) dz0=dz0/h dz1=dz1/h sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut) esig=1. do l=1,20 print*,'esig=',esig esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.) enddo csig=(1./sig1-1.)/(exp(esig)-1.) DO L = 2, llm zz=csig*(exp(esig*(l-1.))-1.) sig(l) =1./(1.+zz) & * tanh(.5*(llm+1-l)/nhaut) ENDDO sig(1)=1. sig(llm+1)=0. do l = 1, llm dsig(l) =sig(l)-sig(l+1) enddo else print*,'WARNING!!! Ancienne discretisation verticale' stop h=7. snorm = 0. do l = 1, llm x = 2.*asin(1.) * (float(l)-0.5) / float(llm+1) dsig(l) = 1.0 + 7.0 * sin(x)**2 snorm = snorm + dsig(l) enddo snorm = 1./snorm do l = 1, llm dsig(l) = dsig(l)*snorm enddo sig(llm+1) = 0. do l = llm, 1, -1 sig(l) = sig(l+1) + dsig(l) enddo endif c----------------------------------------------------------------------- c calcul de s, ds, sdsig... c ------------------------- quoi = 1. + 2.* kappa s( llm ) = 1. s(lllmm1) = quoi IF( llm.gt.2 ) THEN DO ll = 2, lllmm1 l = lllmp1 - ll quand = sig(l+1)/ sig(l) s(l-1) = quoi * (1.-quand) * s(l) + quand * s(l+1) ENDDO END IF c snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2) DO l = 1, llm s(l) = s(l)/ snorm ENDDO DO l = 2, llm ds(l) = s(l-1) - s(l) ENDDO ds(1) = 1. - s(1) c DO l = 1, llm sdsig(l) = s(l) * dsig(l) dsig1(l)= 1./dsig(l) ENDDO c----------------------------------------------------------------------- c c Diagnostique sur la discretisation verticale: c --------------------------------------------- c print*,'Diagnostique de la discretisation verticale' print* print*,'comparaison de sig(l) et (s(l)+s(l+1))/2)**(1/K)' do 14 l=1,llm-1 sigbid=(0.5*(s(l)+s(l+1)))**(1./kappa) print*,'sig(',l+1,') = ',sig(l+1), S ' valeur approchee :',sigbid,' ',dsig(l) 14 continue print* print*,'comparaison de s(l) et (sig(l)+sig(l+1))/2)**K' do 15 l=1,llm sbid=(0.5*(sig(l+1)+sig(l)))**kappa print*,' s(',l,') = ',s(l), S ' valeur approchee :',sbid 15 continue c PRINT*,'Altitude approchee z,dz' PRINT* z1=0. print*,' l Z DZ Ztop dsig' DO 18 l=1,llm-1 z2=-h*log(sig(l+1)) write(*,'(i5,3x,4f8.4)') l,-h*log(s(l))/kappa,z2-z1,z2 & ,dsig(l) write(14,'(3x,i5,1f10.4)') l,-h*log(s(l))/kappa z1=z2 18 CONTINUE write(*,'(i5,3x,3f8.4)') l,-h*log(s(llm))/kappa write(14,'(3x,i5,1f10.4)') l,-h*log(s(llm))/kappa c----------------------------------------------------------------------- RETURN END