Ignore:
Timestamp:
Mar 14, 2023, 10:07:33 AM (22 months ago)
Author:
romain.vande
Message:

Mars PCM:
Adapt start2archive.F to the subslope parametrisation.
Small correction for some dimensions of variables.
RV

Location:
trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/ini_archive.F

    r2573 r2913  
    11c=======================================================================
    2       subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi)
     2      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi
     3     &                      ,def_slope,subslope_dist)
    34c=======================================================================
    45c
     
    4041      USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy
    4142      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
     43      use comslope_mod, ONLY: nslope
    4244      implicit none
    4345
     
    6668      REAL              phis(ip1jmp1)
    6769      real ith(ip1jmp1,nsoilmx)
     70      real subslope_dist(ip1jmp1,nslope)
     71      real def_slope(nslope+1)
    6872      REAL              tab_cntrl_fi(length)
    6973
     
    7781      INTEGER idim_tim
    7882      INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID #
     83      INTEGER idim_nslope, idim_nslope_p1
    7984      INTEGER nid,nvarid
    8085      real sig_s(llm),s(llm)
     
    163168      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
    164169      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
     170      ierr = NF_DEF_DIM (nid,"nslope", nslope, idim_nslope)
     171      ierr = NF_DEF_DIM (nid,"nslope_plus_1",nslope+1,idim_nslope_p1)
    165172
    166173c
     
    513520#endif
    514521
     522c Put subslope dist
     523      dims3(1)=idim_rlonv
     524      dims3(2)=idim_rlatu
     525      dims3(3)=idim_nslope
     526      ierr = NF_REDEF (nid)
     527#ifdef NC_DOUBLE
     528      ierr = NF_DEF_VAR (nid, "subslope_dist", NF_DOUBLE, 3,
     529     .       dims3,nvarid)
     530#else
     531      ierr = NF_DEF_VAR (nid, "subslope_dist", NF_FLOAT, 3,
     532     .       dims3,nvarid)
     533#endif
     534      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",13,
     535     .    "subslope_dist")
     536
     537      ierr = NF_ENDDEF(nid)
     538#ifdef NC_DOUBLE
     539      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,subslope_dist)
     540#else
     541      ierr = NF_PUT_VAR_REAL (nid,nvarid,subslope_dist)
     542#endif
     543
     544c Put def_slope
     545
     546      ierr = NF_REDEF (nid)
     547#ifdef NC_DOUBLE
     548      ierr = NF_DEF_VAR (nid, "def_slope", NF_DOUBLE, 1,
     549     .       [idim_nslope_p1],nvarid)
     550#else
     551      ierr = NF_DEF_VAR (nid, "def_slope", NF_FLOAT, 1,
     552     .       [idim_nslope_p1],nvarid)
     553#endif
     554      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",7,"def_slope")
     555      ierr = NF_ENDDEF(nid)
     556#ifdef NC_DOUBLE
     557      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,def_slope)
     558#else
     559      ierr = NF_PUT_VAR_REAL (nid,nvarid,def_slope)
     560#endif
     561
    515562      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
    516563      PRINT*,'rad,omeg,g,mugaz,kappa',
  • trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive.F

    r2828 r2913  
    3333      USE phyetat0_mod, ONLY: phyetat0
    3434      USE exner_hyb_m, ONLY: exner_hyb
     35      use comslope_mod, ONLY: nslope,def_slope,def_slope_mean,
     36     &                        subslope_dist
     37      USE comcstfi_h, only: pi
    3538      implicit none
    3639
     
    6164c Variable Physiques (grille physique)
    6265c ------------------------------------
    63       REAL tsurf(ngridmx)        ! Surface temperature
    64       REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
    65       REAL watercap(ngridmx)        ! h2o ice layer
    66       REAL tauscaling(ngridmx) ! dust conversion factor
    67       REAL totcloudfrac(ngridmx) ! sub-grid cloud fraction
     66      REAL,ALLOCATABLE :: tsurf(:,:)        ! Surface temperature
     67      REAL,ALLOCATABLE :: tsoil(:,:,:) ! Soil temperature
     68      REAL,ALLOCATABLE :: watercap(:,:)        ! h2o ice layer
     69      REAL :: tauscaling(ngridmx) ! dust conversion factor
     70      REAL:: totcloudfrac(ngridmx) ! sub-grid cloud fraction
    6871      REAL q2(ngridmx,llm+1)
    69       REAL emis(ngridmx)
    70       REAL albedo(ngridmx,2)
     72      REAL,ALLOCATABLE :: emis(:,:)
     73      REAL,ALLOCATABLE :: albedo(:,:,:)
    7174      REAL wstar(ngridmx)
    7275      INTEGER start,length
     
    7881c ------------------------------------
    7982      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
    80       REAL tsurfS(ip1jmp1)
    81       REAL tsoilS(ip1jmp1,nsoilmx)
     83      REAL,ALLOCATABLE :: tsurfS(:,:)
     84      REAL,ALLOCATABLE :: tsoilS(:,:,:)
    8285      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
    83       REAL watercapS(ip1jmp1)
    84       REAL tauscalingS(ip1jmp1)
    85       REAL totcloudfracS(ip1jmp1)
     86      REAL,ALLOCATABLE :: watercapS(:,:)
     87      REAL :: tauscalingS(ip1jmp1)
     88      REAL :: totcloudfracS(ip1jmp1)
    8689      REAL q2S(ip1jmp1,llm+1)
    87       REAL,ALLOCATABLE :: qsurfS(:,:)
    88       REAL emisS(ip1jmp1)
    89       REAL albedoS(ip1jmp1)
     90      REAL,ALLOCATABLE :: qsurfS(:,:,:)
     91      REAL,ALLOCATABLE :: emisS(:,:)
     92      REAL,ALLOCATABLE :: albedoS(:,:)
     93      REAL, ALLOCATABLE :: subslope_distS(:,:)
    9094
    9195c Variables intermediaires : vent naturel, mais pas coord scalaire
     
    106110      data  fichier /'startfi'/
    107111
    108       INTEGER ij, l,i,j,isoil,iq
     112      INTEGER ij, l,i,j,isoil,iq,islope
    109113      character*80      fichnom
    110114      integer :: ierr,ntime
     
    133137
    134138! allocate arrays:
    135       allocate(q(ip1jmp1,llm,nqtot))
    136       allocate(qsurfS(ip1jmp1,nqtot))
    137      
     139      allocate(q(ip1jmp1,llm,nqtot))     
    138140
    139141      fichnom = 'start.nc'
     
    161163      Lmodif=0
    162164
     165      allocate(tsurf(ngridmx,nslope))
     166      allocate(tsoil(ngridmx,nsoilmx,nslope))
     167      allocate(watercap(ngridmx,nslope))
     168      allocate(emis(ngridmx,nslope))
     169      allocate(albedo(ngridmx,2,nslope))
     170
     171      allocate(qsurfS(ip1jmp1,nqtot,nslope))
     172      allocate(tsurfS(ip1jmp1,nslope))
     173      allocate(tsoilS(ip1jmp1,nsoilmx,nslope))
     174      allocate(watercapS(ip1jmp1,nslope))
     175      allocate(emisS(ip1jmp1,nslope))
     176      allocate(albedoS(ip1jmp1,nslope))
     177      allocate(subslope_distS(ip1jmp1,nslope))
     178
    163179      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
    164180     &      day_ini_fi,timefi,tsurf,tsoil,albedo,emis,q2,qsurf,
    165      &      tauscaling,totcloudfrac,wstar,watercap)
     181     &      tauscaling,totcloudfrac,wstar,watercap,def_slope,
     182     &      def_slope_mean,subslope_dist)
    166183
    167184       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
     
    257274c-----------------------------------------------------------------------
    258275
    259       call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
    260       call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap,watercapS)
    261       call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
     276      do islope=1,nslope
     277      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf(:,islope),
     278     &    tsurfS(:,islope))
     279      call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap(:,islope),
     280     &    watercapS(:,islope))
     281      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil(:,:,islope),
     282     &    tsoilS(:,:,islope))
    262283      ! Note: thermal inertia "inertiedat" is in comsoil.h
     284      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis(:,islope),
     285     &     emisS(:,islope))
     286      call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1,islope),
     287     &   albedoS(:,islope))
     288      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf(:,:,islope),
     289     &   qsurfS(:,:,islope))
     290      call gr_fi_dyn(1,ngridmx,iip1,jjp1,subslope_dist(:,islope),
     291     &    subslope_distS(:,islope))
     292      enddo
    263293      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
    264       call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
    265       call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1),albedoS)
    266294      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
    267       call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
    268295      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
    269296      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totcloudfrac,totcloudfracS)
     
    283310      DO j=1,jjp1
    284311         DO i=1,iim
     312           DO islope=1,nslope
    285313           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
    286314           co2icetotal = co2icetotal +
    287      &            qsurfS(i+(iim+1)*(j-1),igcm_co2)*aire(i+(iim+1)*(j-1))
     315     &        qsurfS(i+(iim+1)*(j-1),igcm_co2,islope)*
     316     &        aire(i+(iim+1)*(j-1))*
     317     &    subslope_distS(i+(iim+1)*(j-1),islope)/
     318     &    cos(pi*def_slope_mean(islope))
     319           ENDDO
    288320         ENDDO
    289321      ENDDO
     
    324356         ierr = NF_CREATE('start_archive.nc',
    325357     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
    326          call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
     358         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi,
     359     &         def_slope,subslope_distS)
    327360      endif
    328361
     
    398431        txt=trim(tname(iq))//"_surf"
    399432        call write_archive(nid,ntime,txt,'Tracer on surface',
    400      &  'kg.m-2',2,qsurfS(1,iq))
     433     &  'kg.m-2',2,qsurfS(:,iq,:))
    401434      enddo
    402435
     
    417450! Write soil temperatures tsoil
    418451      call write_archive(nid,ntime,'tsoil','Soil temperature',
    419      &     'K',-3,tsoilS)
     452     &     'K',-3,tsoilS(:,:,:))
    420453
    421454! Write soil thermal inertia
  • trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F

    r1422 r2913  
    3333
    3434      use comsoil_h, only: nsoilmx
     35      use comslope_mod, ONLY: nslope
    3536      implicit none
    3637
     
    5859
    5960c local
    60       integer, dimension(4) :: edges,corner,id
     61      integer, dimension(5) :: edges,corner,id
    6162      integer :: varid,i,j,l
    6263c-----------------------------------------------------------------------
     
    124125        ! get variables' ID, if it exists
    125126        ierr=NF_INQ_VARID(nid,nom,varid)
     127
     128        if(nom.eq."tsoil") then
     129
     130         if (ierr.ne.NF_NOERR) then ! variable not defined yet
     131          ! build related coordinates
     132          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
     133          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
     134          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
     135          if (ierr.ne.NF_NOERR) then
     136           write(*,*)"write_archive: dimension <subsurface_layers>",
     137     &               " is missing !!!"
     138           call abort
     139          endif
     140          ierr=NF_INQ_DIMID(nid,"nslope",id(4))
     141          if (ierr.ne.NF_NOERR) then
     142           write(*,*)"write_archive: dimension <nslope>",
     143     &               " is missing !!!"
     144           call abort
     145          endif
     146          ierr=NF_INQ_DIMID(nid,"Time",id(5))
     147         
     148          ! define the variable
     149          write(*,*)"====================="
     150          write(*,*)"defining ",nom
     151          call def_var(nid,nom,titre,unite,5,id,varid,ierr)
     152         
     153         endif
     154
     155        ! build cedges and corners
     156        corner(1)=1
     157        corner(2)=1
     158        corner(3)=1
     159        corner(4)=1
     160        corner(5)=ntime
     161
     162        edges(1)=iip1
     163        edges(2)=jjp1
     164        edges(3)=nsoilmx
     165        edges(4)=nslope
     166        edges(5)=1
     167
     168#ifdef NC_DOUBLE
     169           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
     170#else
     171           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
     172#endif
     173
     174        else
    126175       
    127176         if (ierr.ne.NF_NOERR) then ! variable not defined yet
     
    160209#endif
    161210
     211       endif
     212
    162213
    163214! For a surface 2D Variable
     
    169220
    170221           ierr= NF_INQ_VARID(nid,nom,varid)
     222
     223           if(nom.eq."tauscaling" .or. nom.eq."totcloudfrac" .or.
     224     &        nom.eq."ps" .or. nom.eq."q2surf") then
     225
    171226           if (ierr /= NF_NOERR) then
    172227!  choix du nom des coordonnees
     
    203258              call abort
    204259           endif
     260 
     261       else
     262
     263           if (ierr /= NF_NOERR) then
     264!  choix du nom des coordonnees
     265              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
     266              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
     267              ierr= NF_INQ_DIMID(nid,"nslope",id(3))
     268              ierr= NF_INQ_DIMID(nid,"Time",id(4))
     269
     270! Creation de la variable si elle n'existait pas
     271
     272              write (*,*) "====================="
     273              write (*,*) "creation de ",nom
     274
     275              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
     276
     277           endif
     278
     279           corner(1)=1
     280           corner(2)=1
     281           corner(3)=1
     282           corner(4)=ntime
     283
     284           edges(1)=iip1
     285           edges(2)=jjp1
     286           edges(3)=nslope
     287           edges(4)=1
     288
     289
     290#ifdef NC_DOUBLE
     291           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
     292#else         
     293           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
     294#endif     
     295
     296           if (ierr.ne.NF_NOERR) then
     297              write(*,*) "***** PUT_VAR matter in write_archive"
     298              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
     299              call abort
     300           endif
     301
     302       endif
    205303
    206304
Note: See TracChangeset for help on using the changeset viewer.