Changeset 2914 for trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars

Timestamp:

Mar 14, 2023, 10:30:06 AM (22 months ago)

Author:

romain.vande

Message:

Mars PCM:
Adapt start2archive_SSO.F to the subslope parametrisation.
RV

Location:

trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars

Files:

• start2archive_SSO.F (modified) (12 diffs)
• write_archive.F (modified) (1 diff)

trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive_SSO.F

@@ -33 +33 @@
       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 +67 @@
 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 +87 @@
 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 +128 @@
       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 +155 @@
 
 ! allocate arrays:
-      allocate(q(ip1jmp1,llm,nqtot))
-      allocate(qsurfS(ip1jmp1,nqtot))
-      
+      allocate(q(ip1jmp1,llm,nqtot))      
 
       fichnom = 'start.nc'
@@ -178 +181 @@
       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 +289 @@
 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 +337 @@
       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 +383 @@
          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 +427 @@
      &  '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 +470 @@
         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 +489 @@
 ! Write soil temperatures tsoil
       call write_archive(nid,ntime,'tsoil','Soil temperature',
-     &     'K',-3,tsoilS)
+     &     'K',-3,tsoilS(:,:,:))
 
 ! Write soil thermal inertia

trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F

@@ -222 +222 @@
 
            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