program rcm1d use radcommon_h, only: tauvis ! to use 'getin' use ioipsl_getincom implicit none !================================================================== ! ! Purpose ! ------- ! Run the physics package of the universal model in a 1D column. ! ! It can be compiled with a command like (e.g. for 25 layers): ! "makegcm -p std -d 25 rcm1d" ! It requires the files "callphys.def", "z2sig.def", ! "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def" ! ! Authors ! ------- ! Frederic Hourdin ! R. Fournier ! F. Forget ! F. Montmessin (water ice added) ! R. Wordsworth ! !================================================================== #include "dimensions.h" #include "dimphys.h" #include "comgeomfi.h" #include "surfdat.h" #include "comsoil.h" #include "comdiurn.h" #include "callkeys.h" #include "comcstfi.h" #include "planete.h" #include "comsaison.h" #include "control.h" #include "comvert.h" #include "netcdf.inc" #include "watercap.h" #include "fisice.h" #include "logic.h" #include "advtrac.h" c -------------------------------------------------------------- c Declarations c -------------------------------------------------------------- c INTEGER unitstart ! unite d'ecriture de "startfi" INTEGER nlayer,nlevel,nsoil,ndt INTEGER ilayer,ilevel,isoil,idt,iq LOGICAl firstcall,lastcall c INTEGER day0 ! date initial (sol ; =0 a Ls=0) REAL day ! date durant le run REAL time ! time (0 area(1)=1.E+0 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 "inifis" reproduit un certain nombre d'initialisations deja faites 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 !Mars possible issue with dtphys in input and include!!! CALL inifis(1,llm,day0,daysec,dtphys, . lati,long,area,rad,g,r,cpp) c Initialisation pour prendre en compte les vents en 1-D c ------------------------------------------------------ ptif=2.E+0*omeg*sinlat(1) c vent geostrophique gru=10. ! default value for gru PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?' call getin("u",gru) write(*,*) " u = ",gru grv=0. !default value for grv PRINT *,'meridional northward component of the geostrophic', &' wind (m/s) ?' call getin("v",grv) write(*,*) " v = ",grv c Initialisation des vents au premier pas de temps DO ilayer=1,nlayer u(ilayer)=gru v(ilayer)=grv ENDDO c energie cinetique turbulente DO ilevel=1,nlevel q2(ilevel)=0.E+0 ENDDO c emissivity / surface co2 ice ( + h2o ice??) c ------------------------------------------- emis=emissiv ! default value for emissivity PRINT *,'Emissivity of bare ground ?' call getin("emis",emis) write(*,*) " emis = ",emis emissiv=emis ! we do this so that condense_co2 sets things to the right ! value if there is no snow if(i_co2_ice.gt.0)then qsurf(i_co2_ice)=0 ! default value for co2ice print*,'Initial CO2 ice on the surface (kg.m-2)' call getin("co2ice",qsurf(i_co2_ice)) write(*,*) " co2ice = ",qsurf(i_co2_ice) IF (qsurf(i_co2_ice).ge.1.E+0) THEN ! if we have some CO2 ice on the surface, change emissivity if (lati(1).ge.0) then ! northern hemisphere emis=emisice(1) else ! southern hemisphere emis=emisice(2) endif ENDIF endif c calcul des pressions et altitudes en utilisant les niveaux sigma c ---------------------------------------------------------------- c Vertical Coordinates c """""""""""""""""""" hybrid=.true. PRINT *,'Hybrid coordinates ?' call getin("hybrid",hybrid) write(*,*) " hybrid = ", hybrid autozlevs=.false. PRINT *,'Auto-discretise vertical levels ?' call getin("autozlevs",autozlevs) write(*,*) " autozlevs = ", autozlevs pceil=100.0 ! Pascals PRINT *,'Ceiling pressure (Pa) ?' call getin("pceil",pceil) write(*,*) " pceil = ", pceil ! Test of incompatibility: ! if autozlevs used, cannot have hybrid too if (autozlevs.and.hybrid) then print*,'Cannot use autozlevs and hybrid together!' call abort endif if(autozlevs)then open(91,file="z2sig.def",form='formatted') read(91,*) Hscale DO ilayer=1,nlayer-2 read(91,*) Hmax enddo close(91) print*,'Hmax = ',Hmax,' km' print*,'Auto-shifting Hscale to:' ! Hscale = Hmax / log(psurf/100.0) Hscale = Hmax / log(psurf/pceil) print*,'Hscale = ',Hscale,' km' ! none of this matters if we dont care about zlay endif call disvert if(.not.autozlevs)then ! we want only the scale height from z2sig, in order to compute zlay open(91,file="z2sig.def",form='formatted') read(91,*) Hscale close(91) endif ! if(autozlevs)then ! open(94,file="Hscale.temp",form='formatted') ! read(94,*) Hscale ! close(94) ! endif DO ilevel=1,nlevel plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) ENDDO DO ilayer=1,nlayer play(ilayer)=aps(ilayer)+psurf*bps(ilayer) ENDDO DO ilayer=1,nlayer ! zlay(ilayer)=-300.E+0 *r*log(play(ilayer)/plev(1)) ! & /g zlay(ilayer)=-1000.0*Hscale*log(play(ilayer)/plev(1)) ENDDO ! endif c profil de temperature au premier appel c -------------------------------------- pks=psurf**rcp c altitude en km dans profile: on divise zlay par 1000 tmp1(0)=0.E+0 DO ilayer=1,nlayer tmp1(ilayer)=zlay(ilayer)/1000.E+0 ENDDO call profile(nlayer+1,tmp1,tmp2) tsurf=tmp2(0) DO ilayer=1,nlayer temp(ilayer)=tmp2(ilayer) ENDDO ! Initialize soil properties and temperature ! ------------------------------------------ volcapa=1.e6 ! volumetric heat capacity DO isoil=1,nsoil inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia tsoil(isoil)=tsurf ! soil temperature ENDDO ! Initialize depths ! ----------------- do isoil=0,nsoil-1 mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth enddo do isoil=1,nsoil layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth enddo c Ecriture de "startfi" c -------------------- c (Ce fichier sera aussitot relu au premier c appel de "physiq", mais il est necessaire pour passer c les variables purement physiques a "physiq"... call physdem1("startfi.nc",long,lati,nsoilmx,nqmx, & dtphys,float(day0), & time,tsurf,tsoil,emis,q2,qsurf, & area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe, & cloudfrac,totcloudfrac,hice) c======================================================================= c BOUCLE TEMPORELLE DU MODELE 1D c======================================================================= firstcall=.true. lastcall=.false. DO idt=1,ndt IF (idt.eq.ndt) then !test lastcall=.true. call stellarlong(day*1.0,zls) ! write(103,*) 'Ls=',zls*180./pi ! write(103,*) 'Lat=', lati(1)*180./pi ! write(103,*) 'Tau=', tauvis/700*psurf ! write(103,*) 'RunEnd - Atmos. Temp. File' ! write(103,*) 'RunEnd - Atmos. Temp. File' ! write(104,*) 'Ls=',zls*180./pi ! write(104,*) 'Lat=', lati(1) ! write(104,*) 'Tau=', tauvis/700*psurf ! write(104,*) 'RunEnd - Atmos. Temp. File' ENDIF c calcul du geopotentiel c ~~~~~~~~~~~~~~~~~~~~~ if(nonideal)then DO ilayer=1,nlayer call calc_cpp3d(cpp3D(1,ilayer), $ rcp3D(1,ilayer),temp(ilayer),play(ilayer)) ENDDO DO ilayer=1,nlayer ! if(autozlevs)then ! s(ilayer)=(play(ilayer)/psurf)**rcp3D(1,ilayer) ! else s(ilayer)= & (aps(ilayer)/psurf+bps(ilayer))**rcp3D(1,ilayer) ! endif h(ilayer)=cpp3D(1,ilayer)*temp(ilayer)/(pks*s(ilayer)) ENDDO else DO ilayer=1,nlayer ! if(autozlevs)then ! s(ilayer)=(play(ilayer)/psurf)**rcp ! else s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp ! endif !s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer)) ENDDO endif ! DO ilayer=1,nlayer ! s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp ! 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 appel de la physique c -------------------- CALL physiq (1,llm,nqmx, , firstcall,lastcall, , day,time,dtphys, , plev,play,phi, , u, v,temp, q, , w, C - sorties s du, dv, dtemp, dq,dpsurf,tracerdyn) 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 c DO ilayer=1,nlayer c du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv) c dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru) c ENDDO c Pour certain test : pas de coriolis a l'equateur c 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 c end if c c c Calcul du temps 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 calcul des vitesses et temperature au pas de temps suivant c ---------------------------------------------------------- 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 calcul des pressions au pas de temps suivant c ---------------------------------------------------------- psurf=psurf+dtphys*dpsurf ! evolution de la pression de surface DO ilevel=1,nlevel plev(ilevel)=ap(ilevel)+psurf*bp(ilevel) ENDDO DO ilayer=1,nlayer play(ilayer)=aps(ilayer)+psurf*bps(ilayer) ENDDO c calcul traceur au pas de temps suivant c -------------------------------------- DO iq = 1, nqmx DO ilayer=1,nlayer q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq) ENDDO END DO ENDDO ! fin de la boucle temporelle c ======================================================== c GESTION DES SORTIE c ======================================================== ! save temperature profile if(saveprofile)then OPEN(12,file='profile.out',form='formatted') DO ilayer=1,nlayermx write(12,*) temp(ilayer), play(ilayer) ENDDO CLOSE(12) endif c ======================================================== end !rcm1d c*********************************************************************** c*********************************************************************** c Subroutines Bidons utilise seulement en 3D, mais c necessaire a la compilation de rcm1d en 1D subroutine gr_fi_dyn RETURN END c*********************************************************************** c*********************************************************************** #include "../dyn3d/disvert.F"