*=*=*=*= radia1d.html =*=*=*=*
PROGRAM radia1d IMPLICIT NONE #include "dimensions.h" #include "dimphys.h" #include "comgeomfi.h" #include "surfdat.h" #include "comdiurn.h" #include "callkeys.h" #include "comcstfi.h" #include "planete.h" #include "comsaison.h" c Arguments : c ----------- INTEGER ngrid,nlayer,nq REAL plev(nlayermx+1),play(nlayermx) REAL temp(nlayermx) REAL psrf c dynamial tendencies INTEGER l,ierr,aslun,nlevel,iaer c REAL day_ini,time,longitude,latitude REAL zlay(nlayermx) REAL ztlev(nlayermx+1) REAL zplanck REAL zrad(nlayermx),zradc(nlayermx) REAL zdum1(nlayermx) REAL zdum2(nlayermx) REAL zdum3(nlayermx) REAL zdum4(nlayermx) REAL zdum5(nlayermx) REAL stephan REAL ztim1,ztim2,ztim3 REAL zco2,zp REAL ls,zmax,tau,tau_tot REAL dtlw(nlayermx),dtsw(nlayermx) REAL dtlwcl(nlayermx),dtswcl(nlayermx) REAL zflux(6) REAL aerosol(nlayermx,5),cst_aer,pview REAL tsurf,tsoil(nsoilmx) REAL co2ice,albedo(2),emis REAL dtrad(nlayermx),fluxrad DATA stephan/5.67e-08/ DATA psrf,zmax/775.,9./ DATA ls,time,latitude,longitude/0.,12.,0.,0./ DATA diurnal/.true./ DATA tau/.5/ c WARNING declin and dist_sol are prescribed instead of Ls DATA declin,dist_sol/-24.8,1.4/ c----------------------------------------------------------------------- c 1. Initialisations : c -------------------- PRINT*,'tau?' READ(5,*) tau PRINT*,'time 0 to 24 h' READ(5,*) time PRINT*,'latitude (degrees)' READ(5,*) latitude pi=2.*asin(1.) ls=ls*pi/180. time=time/24. latitude=latitude*pi/180. longitude=longitude*pi/180. declin=declin*pi/180. ngrid=1 nlayer=nlayermx nlevel=nlayer+1 rad=3397200. omeg=4.*asin(1.)/(88775.) g=3.72 mugaz=43.49 rcp=.256793 unjours=88775. daysec=unjours r = 8.314511*1000./mugaz cpp = r/rcp PRINT*,'Cp = ',cpp PRINT*,'R = ',r CALL readparam tsurf=200. DO l=1,nlayer zlay(l)=zmax*(l-.5)/nlayer plev(l)=psrf*exp(-zmax*(l-1.)/nlayer) play(l)=psrf*exp(-zlay(l)) ENDDO plev(nlevel)=0. DO l=1,nlayer temp(l)=200. ENDDO DO l=1,nlayer dtrad(l)=0. ENDDO fluxrad=0. albedo(1)=.24 albedo(2)=.24 emis=1. CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit) c a total otempical detemph of .2 for Ps=700Pa cst_aer=tau/700. pview=1.66 CALL sucst(66,19900101,8000000,g,rad,mugaz,rcp,unjours) CALL surad(6) IF (ngrid.NE.ngridmx) THEN PRINT*,'STOP in inifis' PRINT*,'Probleme de dimenesions :' PRINT*,'ngrid = ',ngrid PRINT*,'ngridmx = ',ngridmx STOP ENDIF c----------------------------------------------------------------------- c 2. Calcul of the radiative tendencies : c --------------------------------------- c CALL orbite(ls,dist_sol,declin) IF(diurnal) THEN ztim1=SIN(declin) ztim2=COS(declin)*COS(2.*pi*(time-.5)) ztim3=-COS(declin)*SIN(2.*pi*(time-.5)) CALL solang(ngrid,sin(longitude),cos(longitude), s sin(latitude),cos(latitude), s ztim1,ztim2,ztim3, s mu0,fract) PRINT*,'time, declin, sinlon,coslon,sinlat,coslat' PRINT*,time, declin,sin(longitude),cos(longitude), s sin(latitude),cos(latitude) ELSE CALL mucorr(ngrid,declin, lati, mu0, fract,10000.,rad) ENDIF c 2.2 Calcul of the radiative tendencies and fluxes: c -------------------------------------------------- c 2.1.1 layers tau_tot=0. DO l=1,nlayer zp=plev(1)/play(l) aerosol(l,1)=amax1(cst_aer* s (plev(l)-plev(l+1)) s *exp(.03*(1.-zp)),1.e-33) aerosol(l,1)=amax1( s tau*(plev(l)-plev(l+1))/plev(1) s *exp(.007*(1.-zp)),1.e-33) tau_tot=tau_tot+aerosol(l,1) ENDDO PRINT*,'tau total',tau_tot DO l=1,nlayermx aerosol(l,1)=aerosol(l,1)*tau/tau_tot ENDDO c 2.1.2 levels c Extrapolation for the air temperature above the surface ztlev(1)=temp(1)+ s (plev(1)-play(1))* s (temp(1)-temp(2))/(play(1)-play(2)) DO l=2,nlevel-1 ztlev(l)=0.5*(temp(l-1)+temp(l)) ENDDO ztlev(nlevel)=temp(nlayer) PRINT*,'temp' DO l=1,nlayer zdum1(l)=0. zdum2(l)=0. zdum3(l)=0. zdum4(l)=0. zdum5(l)=0. DO iaer=2,5 aerosol(l,iaer)=0. ENDDO ENDDO c 2.3 Calcul of the radiative tendencies and fluxes: c -------------------------------------------------- zco2=.95 CALL radite(ngrid,nlayer,0,6,1,1, $ aerosol,albedo,zco2,zdum4,emis, $ mu0,zdum5, $ plev,play,zdum1,zdum2,zdum3,ztlev,tsurf,temp,pview, $ dtlw,dtsw,dtlwcl,dtswcl,zflux,zrad,zradc, $ fract,dist_sol) PRINT*,'radite' c 2.4 total flux and tendencies: c ------------------------------ c 2.4.1 fluxes fluxrad=emis*zflux(4) $ +zflux(5)*(1.-albedo(1)) $ +zflux(6)*(1.-albedo(2)) zplanck=tsurf*tsurf zplanck=emis* $ stephan*zplanck*zplanck fluxrad=fluxrad-zplanck c 2.4.2 temperature tendencies DO l=1,nlayer dtrad(l)=(dtsw(l)+dtlw(l))/unjours dtsw(l)=cpp*dtsw(l)/unjours dtlw(l)=dtlw(l) ENDDO c 2.5 Transformation of the radiative tendencies: c ----------------------------------------------- PRINT*,'Diagnotique for the radaition' PRINT*,'albedo, emissiv, mu0,fract,pview,Frad,Planck' PRINT*,albedo(1),emis,mu0,fract,pview,fluxrad,zplanck PRINT*,'insolation',fract*mu0*1370.,' Fsol=', s zflux(5)+zflux(6) PRINT*,'Tlay Tlev Play Plev z aerosol dT/dt SW dT/dt LW (K/day)' PRINT*,'unjours',unjours DO l=1,nlayer WRITE(*,'(2f7.1,2e11.3,f6.1,3e14.5)') s temp(l),ztlev(l),play(l),plev(l),zlay(l), s g*aerosol(l,1)/(plev(l)-plev(l+1)),dtsw(l),dtlw(l) WRITE(55,'(2e15.5)') -dtlw(l),.001*zlay(l)*r*200./g WRITE(56,'(2e15.5)') dtsw(l),zlay(l) ENDDO END