source: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/start2archive.F @ 3493

Last change on this file since 3493 was 3491, checked in by emillour, 3 months ago

Mars PCM:
Get rid of "start2archive_SSO.F" and adapt start2archive.F to allow adding
sub-grid-scale fields in start_archive.nc. This optional behavior is
triggered at run time by specifying "start2archive.e --add-sso".
EM

File size: 21.5 KB
RevLine 
[38]1c=======================================================================
2      PROGRAM start2archive
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c
10c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
11c   -----    "startfi" a un fichier netcdf unique "start_archive"
12c
13c  "start_archive" est une banque d'etats initiaux:
14c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
15c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
16c
17c
18c
19c=======================================================================
20
[1415]21      use infotrac, only: infotrac_init, nqtot, tname
[3118]22      use comsoil_h, only: nsoilmx, inertiedat, inertiesoil,
23     &                     nqsoil, qsoil
[2959]24      use surfdat_h, only: ini_surfdat_h, qsurf,watercaptag
[1047]25      use comsoil_h, only: ini_comsoil_h
[1543]26!      use comgeomphy, only: initcomgeomphy
[1403]27      use filtreg_mod, only: inifilr
[1543]28      USE mod_const_mpi, ONLY: COMM_LMDZ
[1415]29      use control_mod, only: planet_type
[1422]30      USE comvert_mod, ONLY: ap,bp
[1543]31      USE comconst_mod, ONLY: daysec,dtphys,rad,g,r,cpp
[1422]32      USE temps_mod, ONLY: day_ini,hour_ini
[1543]33      USE iniphysiq_mod, ONLY: iniphysiq
[1944]34      USE phyetat0_mod, ONLY: phyetat0
[2167]35      USE exner_hyb_m, ONLY: exner_hyb
[2913]36      use comslope_mod, ONLY: nslope,def_slope,def_slope_mean,
37     &                        subslope_dist
38      USE comcstfi_h, only: pi
[3216]39      use surfini_mod, only: surfini
[3491]40! SSO parameters:
41      USE surfdat_h, ONLY: phisfi, albedodat, z0, z0_default,
42     &    zmea, zstd, zsig, zgam, zthe, hmons, summit, base
[38]43      implicit none
44
[1543]45      include "dimensions.h"
[1047]46      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)
[1543]47      include "paramet.h"
48      include "comdissip.h"
49      include "comgeom.h"
50      include "netcdf.inc"
[38]51
52c-----------------------------------------------------------------------
53c   Declarations
54c-----------------------------------------------------------------------
55
56c variables dynamiques du GCM
57c -----------------------------
58      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
59      REAL teta(ip1jmp1,llm)                    ! temperature potentielle
[1036]60      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
[38]61      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
62      REAL pk(ip1jmp1,llm)
63      REAL pkf(ip1jmp1,llm)
64      REAL phis(ip1jmp1)                     ! geopotentiel au sol
65      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
66      REAL ps(ip1jmp1)                       ! pression au sol
67      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
68     
69c Variable Physiques (grille physique)
70c ------------------------------------
[2913]71      REAL,ALLOCATABLE :: tsurf(:,:)        ! Surface temperature
72      REAL,ALLOCATABLE :: tsoil(:,:,:) ! Soil temperature
73      REAL,ALLOCATABLE :: watercap(:,:)        ! h2o ice layer
[3139]74      REAL,ALLOCATABLE :: perennial_co2ice(:,:) ! co2 ice layer
[2913]75      REAL :: tauscaling(ngridmx) ! dust conversion factor
76      REAL:: totcloudfrac(ngridmx) ! sub-grid cloud fraction
[1047]77      REAL q2(ngridmx,llm+1)
[2913]78      REAL,ALLOCATABLE :: emis(:,:)
79      REAL,ALLOCATABLE :: albedo(:,:,:)
[1944]80      REAL wstar(ngridmx)
[38]81      INTEGER start,length
82      PARAMETER (length = 100)
83      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
84      INTEGER*4 day_ini_fi
85
86c Variable naturelle / grille scalaire
87c ------------------------------------
88      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
[2913]89      REAL,ALLOCATABLE :: tsurfS(:,:)
90      REAL,ALLOCATABLE :: tsoilS(:,:,:)
[2943]91      REAL,ALLOCATABLE :: inertiesoilS(:,:,:)! Variable Soil Thermal Inertia  (obtained from PEM)
92      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia for inertie dat (present day climate)
[2913]93      REAL,ALLOCATABLE :: watercapS(:,:)
[3139]94      REAL,ALLOCATABLE :: perennial_co2iceS(:,:)
[2959]95      REAL,ALLOCATABLE :: watercaptag_tmp(:)
96      REAL,ALLOCATABLE :: watercaptagS(:)
[2913]97      REAL :: tauscalingS(ip1jmp1)
98      REAL :: totcloudfracS(ip1jmp1)
[1036]99      REAL q2S(ip1jmp1,llm+1)
[2913]100      REAL,ALLOCATABLE :: qsurfS(:,:,:)
101      REAL,ALLOCATABLE :: emisS(:,:)
102      REAL,ALLOCATABLE :: albedoS(:,:)
103      REAL, ALLOCATABLE :: subslope_distS(:,:)
[38]104
[3491]105! For SSO parameters:
106      REAL zmeaS(ip1jmp1)
107      REAL zsigS(ip1jmp1)
108      REAL zstdS(ip1jmp1)
109      REAL zgamS(ip1jmp1)
110      REAL ztheS(ip1jmp1)
111      REAL albedodatS(ip1jmp1)
112      REAL z0S(ip1jmp1)
113      REAL hmonsS(ip1jmp1)
114      REAL summitS(ip1jmp1)
115      REAL baseS(ip1jmp1)
116
117      logical :: add_sso_fields=.false. ! default, don't include SSO fields
118
119
[38]120c Variables intermediaires : vent naturel, mais pas coord scalaire
121c----------------------------------------------------------------
122      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
123
124c Autres  variables
125c -----------------
126      LOGICAL startdrs
127      INTEGER Lmodif
128
129      REAL ptotal, co2icetotal
130      REAL timedyn,timefi !fraction du jour dans start, startfi
131      REAL date
132
133      CHARACTER*2 str2
134      CHARACTER*80 fichier
135      data  fichier /'startfi'/
136
[2913]137      INTEGER ij, l,i,j,isoil,iq,islope
[38]138      character*80      fichnom
139      integer :: ierr,ntime
[2828]140      integer :: igcm_co2
[38]141      integer :: nq,numvanle
142      character(len=30) :: txt ! to store some text
143
144c Netcdf
145c-------
146      integer varid,dimid,timelen
147      INTEGER nid,nid1
148
[3491]149C get command line arguments
150C here we assume and check that if there is an argument #1 then
151C it should be --add-sso to signal adding SSO fileds to start_archive.nc
152
153      CALL get_command_argument(1,txt,j,ierr)
154      ! will return ierr==0 if there is an argument #1 to command line
155      IF (ierr==0) THEN
156        ! Check that argument is indeed "--add-sso" or signal the error
157        IF (trim(txt)=="--add-sso") THEN
158          add_sso_fields=.true.
159          write(*,*) "SSO fields will be included in start_archive"
160        ELSE
161          write(*,*) "start2archive error: unexpected command line "//
162     &    "argument: ",trim(txt)
163          write(*,*) " (only --add-sso currently accepted)"
164          write(*,*) "Might as well stop here."
165          stop
166        ENDIF
167      ENDIF ! of IF (ierr==0)
168
[38]169c-----------------------------------------------------------------------
170c   Initialisations
171c-----------------------------------------------------------------------
172
[999]173      CALL defrun_new(99, .TRUE. )
[1543]174
[1415]175      planet_type='mars'
[38]176
177c=======================================================================
178c Lecture des donnees
179c=======================================================================
[1036]180! Load tracer number and names:
[1415]181      call infotrac_init
[38]182
[1036]183! allocate arrays:
[2913]184      allocate(q(ip1jmp1,llm,nqtot))     
[1036]185
[38]186      fichnom = 'start.nc'
[1415]187      CALL dynetat0(fichnom,vcov,ucov,teta,q,masse,
[38]188     .       ps,phis,timedyn)
189
[1543]190c-----------------------------------------------------------------------
191c   Initialisations
192c-----------------------------------------------------------------------
[38]193
[1543]194      CALL defrun_new(99, .FALSE. )
195      call iniconst
196      call inigeom
197      call inifilr
198
199! Initialize the physics
[3316]200         CALL iniphysiq(iim,jjm,llm,
[1543]201     &                  (jjm-1)*iim+2,comm_lmdz,
202     &                  daysec,day_ini,dtphys,
203     &                  rlatu,rlatv,rlonu,rlonv,
[3305]204     &                  aire,cu,cv,rad,g,r,cpp,1)
[1543]205
[3316]206      fichnom = 'startfi.nc'
[38]207      Lmodif=0
208
[2913]209      allocate(tsurf(ngridmx,nslope))
210      allocate(tsoil(ngridmx,nsoilmx,nslope))
211      allocate(watercap(ngridmx,nslope))
[3139]212      allocate(perennial_co2ice(ngridmx,nslope))
[2913]213      allocate(emis(ngridmx,nslope))
214      allocate(albedo(ngridmx,2,nslope))
215
216      allocate(qsurfS(ip1jmp1,nqtot,nslope))
217      allocate(tsurfS(ip1jmp1,nslope))
218      allocate(tsoilS(ip1jmp1,nsoilmx,nslope))
[2943]219      allocate(inertiesoilS(ip1jmp1,nsoilmx,nslope))
[2913]220      allocate(watercapS(ip1jmp1,nslope))
[3139]221      allocate(perennial_co2iceS(ip1jmp1,nslope))
[2959]222      allocate(watercaptagS(ip1jmp1))
[2913]223      allocate(emisS(ip1jmp1,nslope))
224      allocate(albedoS(ip1jmp1,nslope))
225      allocate(subslope_distS(ip1jmp1,nslope))
226
[3118]227      CALL phyetat0(fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,nqsoil,
228     &      day_ini_fi,timefi,tsurf,tsoil,albedo,emis,q2,qsurf,qsoil,
[3139]229     &      tauscaling,totcloudfrac,wstar,watercap,perennial_co2ice,
[2999]230     &      def_slope, def_slope_mean,subslope_dist)
[38]231
232       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
233       IF (ierr.NE.NF_NOERR) THEN
234         write(6,*)' Pb d''ouverture du fichier'//fichnom
235        CALL ABORT
236       ENDIF
237                                               
238      ierr = NF_INQ_VARID (nid1, "controle", varid)
239      IF (ierr .NE. NF_NOERR) THEN
240       PRINT*, "start2archive: Le champ <controle> est absent"
241       CALL abort
242      ENDIF
243#ifdef NC_DOUBLE
244       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
245#else
246      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
247#endif
248       IF (ierr .NE. NF_NOERR) THEN
249          PRINT*, "start2archive: Lecture echoue pour <controle>"
250          CALL abort
251       ENDIF
252
[3216]253         CALL surfini(ngridmx,nslope,qsurf)
[2959]254
[38]255      ierr = NF_CLOSE(nid1)
256
257c-----------------------------------------------------------------------
258c Controle de la synchro
259c-----------------------------------------------------------------------
[2814]260!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10))
261      if ((mod(day_ini_fi,669).ne.mod(day_ini,669)))
[38]262     &  stop ' Probleme de Synchro entre start et startfi !!!'
263
264
265c *****************************************************************
266c    Option : Reinitialisation des dates dans la premieres annees :
267       do while (day_ini.ge.669)
268          day_ini=day_ini-669
269       enddo
270c *****************************************************************
271
272      CALL pression(ip1jmp1, ap, bp, ps, p3d)
[2167]273      call exner_hyb(ip1jmp1, ps, p3d, pks, pk, pkf)
[38]274
275c=======================================================================
276c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
277c=======================================================================
278c  Les variables modeles dependent de la resolution. Il faut donc
279c  eliminer les facteurs responsables de cette dependance
280c  (pour utiliser newstart)
281c=======================================================================
282
283c-----------------------------------------------------------------------
284c Vent   (depend de la resolution horizontale)
285c-----------------------------------------------------------------------
286c
287c ucov --> un  et  vcov --> vn
288c un --> us  et   vn --> vs
289c
290c-----------------------------------------------------------------------
291
292      call covnat(llm,ucov, vcov, un, vn)
293      call wind_scal(un,vn,us,vs)
294
295c-----------------------------------------------------------------------
296c Temperature  (depend de la resolution verticale => de "sigma.def")
297c-----------------------------------------------------------------------
298c
299c h --> T
300c
301c-----------------------------------------------------------------------
302
303      DO l=1,llm
304         DO ij=1,ip1jmp1
305            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
306         ENDDO
307      ENDDO
308
309c-----------------------------------------------------------------------
310c Variable physique
311c-----------------------------------------------------------------------
312c
313c tsurf --> tsurfS
[2630]314c watercap --> watercapS
[3139]315c perennial_co2ice --> perennial_co2iceS
[38]316c tsoil --> tsoilS
[2943]317c inertiesoil --> inertiesoilS
[2630]318c inertiedat --> ithS
[38]319c emis --> emisS
[2630]320c albedo --> albedoS
[38]321c q2 --> q2S
322c qsurf --> qsurfS
[1208]323c tauscaling --> tauscalingS
[1711]324c totcloudfrac --> totcloudfracS
[38]325c
326c-----------------------------------------------------------------------
327
[2913]328      do islope=1,nslope
329      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf(:,islope),
330     &    tsurfS(:,islope))
331      call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercap(:,islope),
332     &    watercapS(:,islope))
[3139]333      call gr_fi_dyn(1,ngridmx,iip1,jjp1,perennial_co2ice(:,islope),
334     &    perennial_co2iceS(:,islope))
[2913]335      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil(:,:,islope),
336     &    tsoilS(:,:,islope))
[2943]337      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiesoil(:,:,islope),
[2959]338     &    inertiesoilS(:,:,islope))
[38]339      ! Note: thermal inertia "inertiedat" is in comsoil.h
[2913]340      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis(:,islope),
341     &     emisS(:,islope))
342      call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedo(:,1,islope),
343     &   albedoS(:,islope))
344      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf(:,:,islope),
345     &   qsurfS(:,:,islope))
346      call gr_fi_dyn(1,ngridmx,iip1,jjp1,subslope_dist(:,islope),
347     &    subslope_distS(:,islope))
348      enddo
[38]349      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
350      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
[1208]351      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
[1711]352      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totcloudfrac,totcloudfracS)
[38]353
[2959]354      allocate(watercaptag_tmp(ngridmx))
355      do ij=1,ngridmx
356        if(watercaptag(ij)) then
357        watercaptag_tmp(ij)=1
358        else
359        watercaptag_tmp(ij)=0
360        endif
361      enddo
362
363      call gr_fi_dyn(1,ngridmx,iip1,jjp1,watercaptag_tmp(:),
364     &    watercaptagS(:))
365
[3491]366! SSO parameters, if needed:
367      if (add_sso_fields) then
368        call gr_fi_dyn(1,ngridmx,iip1,jjp1,zmea,zmeaS)
369        call gr_fi_dyn(1,ngridmx,iip1,jjp1,zstd,zstdS)
370        call gr_fi_dyn(1,ngridmx,iip1,jjp1,zsig,zsigS)
371        call gr_fi_dyn(1,ngridmx,iip1,jjp1,zthe,ztheS)
372        call gr_fi_dyn(1,ngridmx,iip1,jjp1,zgam,zgamS)
373        call gr_fi_dyn(1,ngridmx,iip1,jjp1,albedodat,albedodatS)
374        call gr_fi_dyn(1,ngridmx,iip1,jjp1,z0,z0S)
375        call gr_fi_dyn(1,ngridmx,iip1,jjp1,hmons,hmonsS)
376        call gr_fi_dyn(1,ngridmx,iip1,jjp1,summit,summitS)
377        call gr_fi_dyn(1,ngridmx,iip1,jjp1,base,baseS)
378      endif
379
[38]380c=======================================================================
381c Info pour controler
382c=======================================================================
383
[2828]384      DO iq=1,nqtot
385        if (trim(tname(iq)) .eq. "co2") then
386           igcm_co2=iq
387        endif
388      enddo
389
[38]390      ptotal =  0.
391      co2icetotal = 0.
392      DO j=1,jjp1
393         DO i=1,iim
[2913]394           DO islope=1,nslope
[38]395           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
396           co2icetotal = co2icetotal +
[2913]397     &        qsurfS(i+(iim+1)*(j-1),igcm_co2,islope)*
398     &        aire(i+(iim+1)*(j-1))*
399     &    subslope_distS(i+(iim+1)*(j-1),islope)/
400     &    cos(pi*def_slope_mean(islope))
401           ENDDO
[38]402         ENDDO
403      ENDDO
404      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
405      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
406
407c-----------------------------------------------------------------------
408c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
409c-----------------------------------------------------------------------
410
411      tab_cntrl_fi(49) = ptotal
412      tab_cntrl_fi(50) = co2icetotal
413
414c=======================================================================
415c Ecriture dans le fichier  "start_archive"
416c=======================================================================
417
418c-----------------------------------------------------------------------
419c Ouverture de "start_archive"
420c-----------------------------------------------------------------------
421
422      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
423 
424c-----------------------------------------------------------------------
425c  si "start_archive" n'existe pas:
426c    1_ ouverture
427c    2_ creation de l'entete dynamique ("ini_archive")
428c-----------------------------------------------------------------------
429c ini_archive:
430c On met dans l'entete le tab_cntrl dynamique (1 a 16)
431c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
432c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
433c-----------------------------------------------------------------------
434
435      if (ierr.ne.NF_NOERR) then
436         write(*,*)'OK, Could not open file "start_archive.nc"'
437         write(*,*)'So let s create a new "start_archive"'
[410]438         ierr = NF_CREATE('start_archive.nc',
439     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
[2913]440         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi,
441     &         def_slope,subslope_distS)
[38]442      endif
443
444c-----------------------------------------------------------------------
445c Ecriture de la coordonnee temps (date en jours)
446c-----------------------------------------------------------------------
447
[999]448      date = day_ini + hour_ini
[38]449      ierr= NF_INQ_VARID(nid,"Time",varid)
450      ierr= NF_INQ_DIMID(nid,"Time",dimid)
451      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
452      ntime=timelen+1
453
454      write(*,*) "******************"
455      write(*,*) "ntime",ntime
456      write(*,*) "******************"
457#ifdef NC_DOUBLE
458      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
459#else
460      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
461#endif
462      if (ierr.ne.NF_NOERR) then
463         write(*,*) "time matter ",NF_STRERROR(ierr)
464         stop
465      endif
466
467c-----------------------------------------------------------------------
[2630]468c Ecriture des champs  (co2ice,emis,albedo,ps,Tsurf,T,u,v,q2,q,qsurf)
[38]469c-----------------------------------------------------------------------
470c ATTENTION: q2 a une couche de plus!!!!
471c    Pour creer un fichier netcdf lisible par grads,
472c    On passe donc une des couches de q2 a part
473c    comme une variable 2D (la couche au sol: "q2surf")
474c    Les lmm autres couches sont nommees "q2atm" (3D)
475c-----------------------------------------------------------------------
476
[2263]477      call write_archive(nid,ntime,'watercap','couche de glace h2o',
478     &  'kg/m2',2,watercapS)
[3139]479      call write_archive(nid,ntime,'perennial_co2ice',
480     &'couche de glace co2','kg/m2',2,perennial_co2iceS)
[2959]481      call write_archive(nid,ntime,'watercaptag','couche de glace h2o',
482     &  'kg/m2',2,watercaptagS)
[1208]483      call write_archive(nid,ntime,'tauscaling',
484     &  'dust conversion factor',' ',2,tauscalingS)
[1711]485      call write_archive(nid,ntime,'totcloudfrac',
486     &  'sub grid cloud fraction',' ',2,totcloudfracS)
[38]487      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
[2630]488      call write_archive(nid,ntime,'albedo','surface albedo',' ',
489     &                             2,albedoS)
[38]490      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
491      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
492      call write_archive(nid,ntime,'temp','temperature','K',3,t)
493      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
494      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
495      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
496     .              q2S)
497      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
498     .              q2S(1,2))
[3491]499! SSO parameters, if needed
500      if (add_sso_fields) then
501        call write_archive(nid,ntime,'ZMEA','zmea',' ',2,zmeaS)
502        call write_archive(nid,ntime,'ZSTD','zstd',' ',2,zstdS)
503        call write_archive(nid,ntime,'ZSIG','zsig',' ',2,zsigS)
504        call write_archive(nid,ntime,'ZTHE','zthe',' ',2,ztheS)
505        call write_archive(nid,ntime,'ZGAM','zgam',' ',2,zgamS)
506        call write_archive(nid,ntime,'albedodat','albedodat',
507     &                             ' ',2,albedodatS)
508        call write_archive(nid,ntime,'z0','z0',' ',2,z0S)
509        call write_archive(nid,ntime,'summit','summit',
510     &                             ' ',2,summitS)
511        call write_archive(nid,ntime,'hmons','hmons',' ',2,hmonsS)
512        call write_archive(nid,ntime,'base','base',' ',2,baseS)
513      endif
[38]514
515c-----------------------------------------------------------------------
[1036]516c Ecriture du champs  q  ( q[1,nqtot] )
[38]517c-----------------------------------------------------------------------
[1036]518      do iq=1,nqtot
[38]519c       write(str2,'(i2.2)') iq
520c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
521c     .         3,q(1,1,iq))
[1130]522        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
[38]523     &         3,q(1,1,iq))
524      end do
525c-----------------------------------------------------------------------
[1036]526c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
[38]527c-----------------------------------------------------------------------
[1036]528      do iq=1,nqtot
[38]529c       write(str2,'(i2.2)') iq
530c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
531c     $  'kg.m-2',2,qsurfS(1,iq))
[1130]532        txt=trim(tname(iq))//"_surf"
[38]533        call write_archive(nid,ntime,txt,'Tracer on surface',
[2913]534     &  'kg.m-2',2,qsurfS(:,iq,:))
[38]535      enddo
536
537
538c-----------------------------------------------------------------------
539c Ecriture du champs  tsoil  ( Tg[1,10] )
540c-----------------------------------------------------------------------
541c "tsoil" Temperature au sol definie dans 10 couches dans le sol
542c   Les 10 couches sont lues comme 10 champs
543c  nommees Tg[1,10]
544
545c      do isoil=1,nsoilmx
546c       write(str2,'(i2.2)') isoil
547c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
548c     .   'K',2,tsoilS(1,isoil))
549c      enddo
550
551! Write soil temperatures tsoil
552      call write_archive(nid,ntime,'tsoil','Soil temperature',
[2913]553     &     'K',-3,tsoilS(:,:,:))
[38]554! Write soil thermal inertia
[2943]555      call write_archive(nid,ntime,'inertiesoil','Soil TI',
556     &     'J.s-1/2.m-2.K-1',-3,inertiesoilS(:,:,:))
557! Write soil thermal inertia for current climate
[2959]558      call write_archive(nid,ntime,'inertiedat',
559     &     'Soil thermal inertia (present day TI)',
[38]560     &     'J.s-1/2.m-2.K-1',-3,ithS)
561
562! Write (0D) volumetric heat capacity (stored in comsoil.h)
563!      call write_archive(nid,ntime,'volcapa',
564!     &     'Soil volumetric heat capacity',
565!     &     'J.m-3.K-1',0,volcapa)
566! Note: no need to write volcapa, it is stored in "controle" table
567
568      ierr=NF_CLOSE(nid)
569c-----------------------------------------------------------------------
570c Fin
571c-----------------------------------------------------------------------
572
[1130]573      write(*,*) "startarchive: all is well that ends well"
574     
[38]575      end
Note: See TracBrowser for help on using the repository browser.