Index: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive_SSO.F =================================================================== --- trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive_SSO.F (revision 2913) +++ trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive_SSO.F (revision 2914) @@ -33,4 +33,7 @@ USE phyetat0_mod, ONLY: phyetat0 USE exner_hyb_m, ONLY: exner_hyb + use comslope_mod, ONLY: nslope,def_slope,def_slope_mean, + & subslope_dist + USE comcstfi_h, only: pi ! AD: SSO parameters USE surfdat_h, ONLY: phisfi, albedodat, z0, z0_default, @@ -64,12 +67,12 @@ c Variable Physiques (grille physique) c ------------------------------------ - REAL tsurf(ngridmx) ! Surface temperature - REAL tsoil(ngridmx,nsoilmx) ! Soil temperature - REAL watercap(ngridmx) ! h2o ice layer + REAL,ALLOCATABLE :: tsurf(:,:) ! Surface temperature + REAL,ALLOCATABLE :: tsoil(:,:,:) ! Soil temperature + REAL,ALLOCATABLE :: watercap(:,:) ! h2o ice layer REAL tauscaling(ngridmx) ! dust conversion factor REAL totcloudfrac(ngridmx) ! sub-grid cloud fraction REAL q2(ngridmx,llm+1) - REAL emis(ngridmx) - REAL albedo(ngridmx,2) + REAL,ALLOCATABLE :: emis(:,:) + REAL,ALLOCATABLE :: albedo(:,:,:) REAL wstar(ngridmx) DOUBLE PRECISION mem_Nccn_co2(ngridmx,llm) @@ -84,13 +87,15 @@ c ------------------------------------ REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm) - REAL tsurfS(ip1jmp1) - REAL tsoilS(ip1jmp1,nsoilmx) + REAL,ALLOCATABLE :: tsurfS(:,:) + REAL,ALLOCATABLE :: tsoilS(:,:,:) REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia - REAL watercapS(ip1jmp1) + REAL,ALLOCATABLE :: watercapS(:,:) REAL tauscalingS(ip1jmp1) REAL totcloudfracS(ip1jmp1) REAL q2S(ip1jmp1,llm+1) - REAL,ALLOCATABLE :: qsurfS(:,:) - REAL emisS(ip1jmp1) + REAL,ALLOCATABLE :: qsurfS(:,:,:) + REAL,ALLOCATABLE :: emisS(:,:) + REAL,ALLOCATABLE :: albedoS(:,:) + REAL, ALLOCATABLE :: subslope_distS(:,:) ! AD: SSO parameters @@ -123,5 +128,5 @@ data fichier /'startfi'/ - INTEGER ij, l,i,j,isoil,iq + INTEGER ij, l,i,j,isoil,iq,islope character*80 fichnom integer :: ierr,ntime @@ -150,7 +155,5 @@ ! allocate arrays: - allocate(q(ip1jmp1,llm,nqtot)) - allocate(qsurfS(ip1jmp1,nqtot)) - + allocate(q(ip1jmp1,llm,nqtot)) fichnom = 'start.nc' @@ -178,7 +181,22 @@ Lmodif=0 + allocate(tsurf(ngridmx,nslope)) + allocate(tsoil(ngridmx,nsoilmx,nslope)) + allocate(watercap(ngridmx,nslope)) + allocate(emis(ngridmx,nslope)) + allocate(albedo(ngridmx,2,nslope)) + + allocate(qsurfS(ip1jmp1,nqtot,nslope)) + allocate(tsurfS(ip1jmp1,nslope)) + allocate(tsoilS(ip1jmp1,nsoilmx,nslope)) + allocate(watercapS(ip1jmp1,nslope)) + allocate(emisS(ip1jmp1,nslope)) + allocate(albedoS(ip1jmp1,nslope)) + allocate(subslope_distS(ip1jmp1,nslope)) + CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot, & day_ini_fi,timefi,tsurf,tsoil,albedo,emis,q2,qsurf, - & tauscaling,totcloudfrac,wstar,watercap) + & tauscaling,totcloudfrac,wstar,watercap,def_slope, + & def_slope_mean,subslope_dist) ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1) @@ -271,12 +289,23 @@ c----------------------------------------------------------------------- - call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS) - call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap,watercapS) - call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS) + do islope=1,nslope + call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf(:,islope), + & tsurfS(:,islope)) + call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap(:,islope), + & watercapS(:,islope)) + call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil(:,:,islope), + & tsoilS(:,:,islope)) ! Note: thermal inertia "inertiedat" is in comsoil.h + call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis(:,islope), + & emisS(:,islope)) + call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1,islope), + & albedoS(:,islope)) + call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf(:,:,islope), + & qsurfS(:,:,islope)) + call gr_fi_dyn(1,ngridmx,iip1,jjp1,subslope_dist(:,islope), + & subslope_distS(:,islope)) + enddo call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS) - call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS) call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S) - call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS) call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS) call gr_fi_dyn(1,ngridmx,iip1,jjp1,totcloudfrac,totcloudfracS) @@ -308,7 +337,12 @@ DO j=1,jjp1 DO i=1,iim + DO islope=1,nslope ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g co2icetotal = co2icetotal + - & qsurfS(i+(iim+1)*(j-1),igcm_co2)*aire(i+(iim+1)*(j-1)) + & qsurfS(i+(iim+1)*(j-1),igcm_co2,islope)* + & aire(i+(iim+1)*(j-1))* + & subslope_distS(i+(iim+1)*(j-1),islope)/ + & cos(pi*def_slope_mean(islope)) + ENDDO ENDDO ENDDO @@ -349,5 +383,6 @@ ierr = NF_CREATE('start_archive.nc', & IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid) - call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi) + call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi, + & def_slope,subslope_distS) endif @@ -392,4 +427,6 @@ & 'sub grid cloud fraction',' ',2,totcloudfracS) call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS) + call write_archive(nid,ntime,'albedo','surface albedo',' ', + & 2,albedoS) call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps) call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS) @@ -433,5 +470,5 @@ txt=trim(tname(iq))//"_surf" call write_archive(nid,ntime,txt,'Tracer on surface', - & 'kg.m-2',2,qsurfS(1,iq)) + & 'kg.m-2',2,qsurfS(:,iq,:)) enddo @@ -452,5 +489,5 @@ ! Write soil temperatures tsoil call write_archive(nid,ntime,'tsoil','Soil temperature', - & 'K',-3,tsoilS) + & 'K',-3,tsoilS(:,:,:)) ! Write soil thermal inertia Index: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F =================================================================== --- trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F (revision 2913) +++ trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F (revision 2914) @@ -222,5 +222,9 @@ if(nom.eq."tauscaling" .or. nom.eq."totcloudfrac" .or. - & nom.eq."ps" .or. nom.eq."q2surf") then + & nom.eq."ps" .or. nom.eq."q2surf" .or. nom.eq."ZMEA" .or. + & nom.eq."ZSTD" .or. nom.eq."ZSIG" .or. nom.eq."ZTHE" .or. + & nom.eq."ZGAM" .or. nom.eq."albedodat" .or. + & nom.eq."z0" .or. nom.eq."summit" .or. nom.eq."hmons" + & .or. nom.eq."base") then if (ierr /= NF_NOERR) then