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

Last change on this file since 3576 was 3576, checked in by jbclement, 5 months ago

COMMON:
Follow-up of r3574:

  • Small corrections to make it work with Git;
  • Addition of the functionality with the programs 'Generic newstart' and 'Generic start2archive';
  • Improvements of the visualization format;
  • Diplaying version control information of every sub-folder in the "trunk" instead of only the "trunk" (who can do more can do less).

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