source: trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/start2archive.F @ 1890

Last change on this file since 1890 was 1890, checked in by jvatant, 7 years ago

Making chemistry handling more flexible - step 2.5
+ For more convenience I introduce specific modules
for chemistry stuff specific to start2archive and newstart
and not to pollute main module comchem_h.
--JVO
File size: 26.5 KB
RevLine 
[711]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
[787]22      USE comsoil_h
[1890]23     
24      USE comchem_h, only : nlaykim_up, preskim
25      USE comchem_startarch_h
[1871]26
[1543]27!      USE comgeomfi_h, ONLY: lati, long, area
[1216]28!      use control_mod
[1543]29!      use comgeomphy, only: initcomgeomphy
[1297]30! to use  'getin'
31      USE ioipsl_getincom
[1316]32      USE planete_mod, only: year_day
[1543]33      USE mod_const_mpi, ONLY: COMM_LMDZ
[1415]34      USE control_mod, only: planet_type
[1403]35      use filtreg_mod, only: inifilr
[1422]36      USE comvert_mod, ONLY: ap,bp
[1543]37      USE comconst_mod, ONLY: daysec,dtphys,rad,g,r,cpp
[1422]38      USE temps_mod, ONLY: day_ini
[1543]39      USE iniphysiq_mod, ONLY: iniphysiq
[1670]40      use phyetat0_mod, only: phyetat0
[1815]41      use tracer_h
[711]42      implicit none
43
[1543]44      include "dimensions.h"
[1308]45      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)
[1543]46      include "paramet.h"
47      include "comdissip.h"
48      include "comgeom.h"
[1216]49!#include "control.h"
[711]50
[1308]51!#include "dimphys.h"
52!#include "planete.h"
[1216]53!#include"advtrac.h"
[1543]54      include "netcdf.inc"
[711]55c-----------------------------------------------------------------------
56c   Declarations
57c-----------------------------------------------------------------------
58
59c variables dynamiques du GCM
60c -----------------------------
61      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
62      REAL teta(ip1jmp1,llm)                    ! temperature potentielle
[1216]63      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
[711]64      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
65      REAL pk(ip1jmp1,llm)
66      REAL pkf(ip1jmp1,llm)
67      REAL beta(iip1,jjp1,llm)
68      REAL phis(ip1jmp1)                     ! geopotentiel au sol
69      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
70      REAL ps(ip1jmp1)                       ! pression au sol
71      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
72     
73c Variable Physiques (grille physique)
74c ------------------------------------
[1543]75      REAL tsurf(ngridmx)        ! Surface temperature
76      REAL,ALLOCATABLE :: tsoil(:,:) ! Soil temperature
[1308]77      REAL q2(ngridmx,llm+1)
[1216]78      REAL,ALLOCATABLE :: qsurf(:,:)
[711]79      REAL emis(ngridmx)
80      INTEGER start,length
81      PARAMETER (length = 100)
82      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
83      REAL tab_cntrl_dyn(length) ! tableau des parametres de start
84      INTEGER*4 day_ini_fi
85
[1871]86c     Added by JVO for Titan specifities
87      REAL tankCH4(ngridmx) ! Depth of surface methane tank
88     
89      ! + Titan upper atm. chemistry 44 fields in comchem_h
[711]90
91c Variable naturelle / grille scalaire
92c ------------------------------------
93      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
94      REAL tsurfS(ip1jmp1)
[1543]95      REAL,ALLOCATABLE :: tsoilS(:,:)
96      REAL,ALLOCATABLE :: ithS(:,:) ! Soil Thermal Inertia
[1216]97      REAL q2S(ip1jmp1,llm+1)
98      REAL,ALLOCATABLE :: qsurfS(:,:)
[711]99      REAL emisS(ip1jmp1)
100
[1871]101c     Added by JVO for Titan specifities
102      REAL tankCH4S(ip1jmp1)  ! Depth of surface methane tank
[711]103
[1871]104      ! + Titan upper atm. chemistry 44 fields in comchem_h
105 
[711]106c Variables intermediaires : vent naturel, mais pas coord scalaire
107c----------------------------------------------------------------
108      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
109
110c Autres  variables
111c -----------------
112      LOGICAL startdrs
113      INTEGER Lmodif
114
[1886]115      LOGICAL kim
[1871]116
[1647]117      REAL ptotal
[711]118      REAL timedyn,timefi !fraction du jour dans start, startfi
119      REAL date
120
121      CHARACTER*2 str2
122      CHARACTER*80 fichier
123      data  fichier /'startfi'/
124
125      INTEGER ij, l,i,j,isoil,iq
126      character*80      fichnom
127      integer :: ierr,ntime
128      integer :: nq,numvanle
129      character(len=30) :: txt ! to store some text
130
131c Netcdf
132c-------
133      integer varid,dimid,timelen
134      INTEGER nid,nid1
135
136c-----------------------------------------------------------------------
137c   Initialisations
138c-----------------------------------------------------------------------
139
[1216]140      CALL defrun_new(99, .TRUE. )
[711]141
[1644]142      planet_type="titan"
[1415]143
[711]144c=======================================================================
145c Lecture des donnees
146c=======================================================================
[1216]147! Load tracer number and names:
[1415]148      call infotrac_init
[711]149
[1216]150! allocate arrays:
151      allocate(q(ip1jmp1,llm,nqtot))
152      allocate(qsurf(ngridmx,nqtot))
153      allocate(qsurfS(ip1jmp1,nqtot))
[1227]154! other array allocations:
[1543]155!      call ini_comsoil_h(ngridmx) ! done via iniphysiq
[1216]156
[711]157      fichnom = 'start.nc'
[1415]158      CALL dynetat0(fichnom,vcov,ucov,teta,q,masse,
[711]159     .       ps,phis,timedyn)
160
161! load 'controle' array from dynamics start file
162
163       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
164       IF (ierr.NE.NF_NOERR) THEN
165         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
166        CALL ABORT
167       ENDIF
168                                               
169      ierr = NF_INQ_VARID (nid1, "controle", varid)
170      IF (ierr .NE. NF_NOERR) THEN
171       PRINT*, "start2archive: Le champ <controle> est absent"
172       CALL abort
173      ENDIF
174#ifdef NC_DOUBLE
175       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_dyn)
176#else
177      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_dyn)
178#endif
179       IF (ierr .NE. NF_NOERR) THEN
180          PRINT*, "start2archive: Lecture echoue pour <controle>"
181          CALL abort
182       ENDIF
183
184      ierr = NF_CLOSE(nid1)
[1543]185
186! Get value of the "subsurface_layers" dimension from physics start file
187      fichnom = 'startfi.nc'
188      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
189       IF (ierr.NE.NF_NOERR) THEN
190         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
191        CALL ABORT
192       ENDIF
193      ierr = NF_INQ_DIMID(nid1,"subsurface_layers",varid)
194      IF (ierr .NE. NF_NOERR) THEN
195       PRINT*, "start2archive: No subsurface_layers dimension!!"
196       CALL abort
197      ENDIF
198      ierr = NF_INQ_DIMLEN(nid1,varid,nsoilmx)
199      IF (ierr .NE. NF_NOERR) THEN
200       PRINT*, "start2archive: Failed reading subsurface_layers value!!"
201       CALL abort
202      ENDIF
[711]203     
[1543]204      ! allocate arrays of nsoilmx size
205      allocate(tsoil(ngridmx,nsoilmx))
206      allocate(tsoilS(ip1jmp1,nsoilmx))
207      allocate(ithS(ip1jmp1,nsoilmx))
[711]208
[1871]209! Get value of the "upper_chemistry_layers" dimension from physics start file
210
211      ierr = NF_INQ_DIMID(nid1,"upper_chemistry_layers",varid)
212      IF (ierr .NE. NF_NOERR) THEN
213       PRINT*, "start2archive: No upper_chemistry_layers dimension!!"
214       CALL abort
215      ENDIF
216      ierr = NF_INQ_DIMLEN(nid1,varid,nlaykim_up)
217      IF (ierr .NE. NF_NOERR) THEN
218       PRINT*, "start2archive: Failed reading
219     . upper_chemistry_layers value!!"
220       CALL abort
221      ENDIF
[1887]222
223      ALLOCATE(preskim(nlaykim_up))
[1871]224     
[1887]225      ! Allocate other arrays of nlaykim_up size, only if they're present
[1871]226      ! The test is on HCN but could be on any as we assume we can't do incomplete chemistry
227
228      ierr = NF_INQ_VARID(nid1,'HCN_up',varid)
229      IF (ierr .NE. NF_NOERR) THEN
230        PRINT*, "start2archive: Missing field(s) for upper chemistry ...
231     . I presume they're all absent !"
[1886]232        kim=.FALSE.
[1871]233      ELSE
234        PRINT*,"start2archive: I found a field for upper chemistry ...
235     . I presume they're all here as you can't do uncomplete chemistry!"
236        ! Allocates upper chemistry fields in comchem_h on physical and scalar grid
[1890]237        CALL alloc_kim_start2archive(ngridmx,ip1jmp1)
[1886]238        kim=.TRUE.
[1871]239      ENDIF
240
241      ierr = NF_CLOSE(nid1)
242
[1543]243c-----------------------------------------------------------------------
244c   Initialisations
245c-----------------------------------------------------------------------
246
247      CALL defrun_new(99, .FALSE. )
248      call iniconst
249      call inigeom
250      call inifilr
251
252! Initialize the physics
253         CALL iniphysiq(iim,jjm,llm,
254     &                  (jjm-1)*iim+2,comm_lmdz,
255     &                  daysec,day_ini,dtphys,
256     &                  rlatu,rlatv,rlonu,rlonv,
257     &                  aire,cu,cv,rad,g,r,cpp,
258     &                  1)
259
[711]260      fichnom = 'startfi.nc'
261      Lmodif=0
262
[1722]263! Initialize tracer names, indexes and properties
[1815]264      CALL initracer2(nqtot,tname)
[1297]265
[1670]266      CALL phyetat0(.true.,ngridmx,llm,fichnom,0,Lmodif,nsoilmx,nqtot,
[1308]267     .      day_ini_fi,timefi,
[1789]268     .      tsurf,tsoil,emis,q2,qsurf,tankCH4)
[711]269
270
[1297]271
[711]272! load 'controle' array from physics start file
273
274       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
275       IF (ierr.NE.NF_NOERR) THEN
276         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
277        CALL ABORT
278       ENDIF
279                                               
280      ierr = NF_INQ_VARID (nid1, "controle", varid)
281      IF (ierr .NE. NF_NOERR) THEN
282       PRINT*, "start2archive: Le champ <controle> est absent"
283       CALL abort
284      ENDIF
285#ifdef NC_DOUBLE
286       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
287#else
288      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
289#endif
290       IF (ierr .NE. NF_NOERR) THEN
291          PRINT*, "start2archive: Lecture echoue pour <controle>"
292          CALL abort
293       ENDIF
294
[1887]295! load upper chemistry pressure grid from physics start file
296
297      ierr = NF_INQ_VARID (nid1, "preskim", varid)
298      IF (ierr .NE. NF_NOERR) THEN
299       PRINT*, "start2archive: Le champ <preskim> est absent"
300       CALL abort
301      ENDIF
302#ifdef NC_DOUBLE
303       ierr = NF_GET_VAR_DOUBLE(nid1, varid, preskim)
304#else
305      ierr = NF_GET_VAR_REAL(nid1, varid, preskim)
306#endif
307       IF (ierr .NE. NF_NOERR) THEN
308          PRINT*, "start2archive: Lecture echoue pour <preskim>"
309          CALL abort
310       ENDIF
311
[711]312      ierr = NF_CLOSE(nid1)
313
314
315c-----------------------------------------------------------------------
316c Controle de la synchro
317c-----------------------------------------------------------------------
318!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10))
319      if ((day_ini_fi.ne.day_ini))
320     &  stop ' Probleme de Synchro entre start et startfi !!!'
321
322
323c *****************************************************************
324c    Option : Reinitialisation des dates dans la premieres annees :
325       do while (day_ini.ge.year_day)
326          day_ini=day_ini-year_day
327       enddo
328c *****************************************************************
329
330      CALL pression(ip1jmp1, ap, bp, ps, p3d)
331      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
332
333c=======================================================================
334c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
335c=======================================================================
336c  Les variables modeles dependent de la resolution. Il faut donc
337c  eliminer les facteurs responsables de cette dependance
338c  (pour utiliser newstart)
339c=======================================================================
340
341c-----------------------------------------------------------------------
342c Vent   (depend de la resolution horizontale)
343c-----------------------------------------------------------------------
344c
345c ucov --> un  et  vcov --> vn
346c un --> us  et   vn --> vs
347c
348c-----------------------------------------------------------------------
349
350      call covnat(llm,ucov, vcov, un, vn)
351      call wind_scal(un,vn,us,vs)
352
353c-----------------------------------------------------------------------
354c Temperature  (depend de la resolution verticale => de "sigma.def")
355c-----------------------------------------------------------------------
356c
357c h --> T
358c
359c-----------------------------------------------------------------------
360
361      DO l=1,llm
362         DO ij=1,ip1jmp1
363            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
364         ENDDO
365      ENDDO
366
367c-----------------------------------------------------------------------
368c Variable physique
369c-----------------------------------------------------------------------
370c
371c tsurf --> tsurfS
372c tsoil --> tsoilS
373c emis --> emisS
374c q2 --> q2S
375c qsurf --> qsurfS
[1789]376c tankCH4 --> tankCH4S
[1871]377c + all 44 chemistry fields
[711]378c
379c-----------------------------------------------------------------------
380
381      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
382      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
383      ! Note: thermal inertia "inertiedat" is in comsoil.h
384      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
385      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
386      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
[1216]387      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
[1789]388      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tankCH4,tankCH4S)
[711]389
[1886]390      IF (kim) THEN ! NB : fields are in comchem_h
[1871]391         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H,H_S)
392         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H2,H2_S)
393         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH,CH_S)
394         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2s,CH2s_S)
395         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2,CH2_S)
396         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3,CH3_S)
397         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH4,CH4_S)
398         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2,C2_S)
399         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H,C2H_S)
400         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H2,C2H2_S)
401         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H3,C2H3_S)
402         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H4,C2H4_S)
403         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H5,C2H5_S)
404         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C2H6,C2H6_S)
405         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H3,C3H3_S)
406         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H5,C3H5_S)
407         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H6,C3H6_S)
408         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H7,C3H7_S)
409         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H,C4H_S)
410         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H3,C4H3_S)
411         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H4,C4H4_S)
412         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H2s,C4H2s_S)
413         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2CCH2,CH2CCH2_S)
414         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3CCH,CH3CCH_S)
415         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H8,C3H8_S)
416         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H2,C4H2_S)
417         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H6,C4H6_S)
418         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H10,C4H10_S)
419         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,AC6H6,AC6H6_S)
420         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3H2,C3H2_S)
421         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4H5,C4H5_S)
422         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,AC6H5,AC6H5_S)
423         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,N2,N2_S)
424         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,N4S,N4S_S)
425         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CN,CN_S)
426         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,HCN,HCN_S)
427         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,H2CN,H2CN_S)
428         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CHCN,CHCN_S)
429         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH2CN,CH2CN_S)
430         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,CH3CN,CH3CN_S)
431         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C3N,C3N_S)
432         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,HC3N,HC3N_S)
433         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,NCCN,NCCN_S)
434         call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,C4N2,C4N2_S)
435      ENDIF
436
[711]437c=======================================================================
438c Info pour controler
439c=======================================================================
440
441      ptotal =  0.
442      DO j=1,jjp1
443         DO i=1,iim
444           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
445         ENDDO
446      ENDDO
447      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
448
449c-----------------------------------------------------------------------
[1647]450c Passage de "ptotal"  par tab_cntrl_fi
[711]451c-----------------------------------------------------------------------
452
453      tab_cntrl_fi(49) = ptotal
[1647]454      tab_cntrl_fi(50) = 0.
[711]455
456c=======================================================================
457c Ecriture dans le fichier  "start_archive"
458c=======================================================================
459
460c-----------------------------------------------------------------------
461c Ouverture de "start_archive"
462c-----------------------------------------------------------------------
463
464      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
465 
466c-----------------------------------------------------------------------
467c  si "start_archive" n'existe pas:
468c    1_ ouverture
469c    2_ creation de l'entete dynamique ("ini_archive")
470c-----------------------------------------------------------------------
471c ini_archive:
472c On met dans l'entete le tab_cntrl dynamique (1 a 16)
473c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
474c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
475c-----------------------------------------------------------------------
476
477      if (ierr.ne.NF_NOERR) then
478         write(*,*)'OK, Could not open file "start_archive.nc"'
479         write(*,*)'So let s create a new "start_archive"'
480         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
481         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi,
482     &                                          tab_cntrl_dyn)
483      endif
484
485c-----------------------------------------------------------------------
486c Ecriture de la coordonnee temps (date en jours)
487c-----------------------------------------------------------------------
488
489      date = day_ini
490      ierr= NF_INQ_VARID(nid,"Time",varid)
491      ierr= NF_INQ_DIMID(nid,"Time",dimid)
492      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
493      ntime=timelen+1
494
495      write(*,*) "******************"
496      write(*,*) "ntime",ntime
497      write(*,*) "******************"
498#ifdef NC_DOUBLE
499      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
500#else
501      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
502#endif
503      if (ierr.ne.NF_NOERR) then
504         write(*,*) "time matter ",NF_STRERROR(ierr)
505         stop
506      endif
507
508c-----------------------------------------------------------------------
[1871]509c Ecriture des champs  (emis,ps,Tsurf,T,u,v,q2,q,qsurf,tankCH4)
[711]510c-----------------------------------------------------------------------
511c ATTENTION: q2 a une couche de plus!!!!
512c    Pour creer un fichier netcdf lisible par grads,
513c    On passe donc une des couches de q2 a part
514c    comme une variable 2D (la couche au sol: "q2surf")
515c    Les lmm autres couches sont nommees "q2atm" (3D)
516c-----------------------------------------------------------------------
517
518      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
519      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
520      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
521      call write_archive(nid,ntime,'temp','temperature','K',3,t)
522      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
523      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
524      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
525     .              q2S)
526      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
527     .              q2S(1,2))
528
529c-----------------------------------------------------------------------
[1216]530c Ecriture du champs  q  ( q[1,nqtot] )
[711]531c-----------------------------------------------------------------------
[1216]532      do iq=1,nqtot
533        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
[711]534     &         3,q(1,1,iq))
535      end do
536c-----------------------------------------------------------------------
[1216]537c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
[711]538c-----------------------------------------------------------------------
[1216]539      do iq=1,nqtot
540        txt=trim(tname(iq))//"_surf"
[711]541        call write_archive(nid,ntime,txt,'Tracer on surface',
542     &  'kg.m-2',2,qsurfS(1,iq))
543      enddo
544
545
546c-----------------------------------------------------------------------
547c Ecriture du champs  tsoil  ( Tg[1,10] )
548c-----------------------------------------------------------------------
549c "tsoil" Temperature au sol definie dans 10 couches dans le sol
550c   Les 10 couches sont lues comme 10 champs
551c  nommees Tg[1,10]
552
553c      do isoil=1,nsoilmx
554c       write(str2,'(i2.2)') isoil
555c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
556c     .   'K',2,tsoilS(1,isoil))
557c      enddo
558
559! Write soil temperatures tsoil
560      call write_archive(nid,ntime,'tsoil','Soil temperature',
561     &     'K',-3,tsoilS)
562
563! Write soil thermal inertia
564      call write_archive(nid,ntime,'inertiedat',
565     &     'Soil thermal inertia',
566     &     'J.s-1/2.m-2.K-1',-3,ithS)
567
568! Write (0D) volumetric heat capacity (stored in comsoil.h)
569!      call write_archive(nid,ntime,'volcapa',
570!     &     'Soil volumetric heat capacity',
571!     &     'J.m-3.K-1',0,volcapa)
572! Note: no need to write volcapa, it is stored in "controle" table
573
[1789]574c-----------------------------------------------------------------
575c Ecriture du champs  tankCH4
576c-----------------------------------------------------------------
577      call write_archive(nid,ntime,'tankCH4',
578     &         'Depth of surface methane tank','m',2,tankCH4S)
[1297]579
[1871]580c-----------------------------------------------------------------
581c Ecriture des champs upper_chemistry
582c-----------------------------------------------------------------
583
[1886]584      IF (kim) THEN
[1871]585         call write_archive(nid,ntime,'H_up',
586     .              'H in upper atmosphere','kg/kg',4,H_S)
587         call write_archive(nid,ntime,'H2_up',
588     .              'H2 in upper atmosphere','kg/kg',4,H2_S)
589         call write_archive(nid,ntime,'CH_up',
590     .              'CH in upper atmosphere','kg/kg',4,CH_S)
591         call write_archive(nid,ntime,'CH2s_up',
592     .              'CH2s in upper atmosphere','kg/kg',4,CH2s_S)
593         call write_archive(nid,ntime,'CH2_up',
594     .              'CH2 in upper atmosphere','kg/kg',4,CH2_S)
595         call write_archive(nid,ntime,'CH3_up',
596     .              'CH3 in upper atmosphere','kg/kg',4,CH3_S)
597         call write_archive(nid,ntime,'CH4_up',
598     .              'CH4 in upper atmosphere','kg/kg',4,CH4_S)
599         call write_archive(nid,ntime,'C2_up',
600     .              'C2 in upper atmosphere','kg/kg',4,C2_S)
601         call write_archive(nid,ntime,'C2H_up',
602     .              'C2H in upper atmosphere','kg/kg',4,C2H_S)
603         call write_archive(nid,ntime,'C2H2_up',
604     .              'C2H2 in upper atmosphere','kg/kg',4,C2H2_S)
605         call write_archive(nid,ntime,'C2H3_up',
606     .              'C2H3 in upper atmosphere','kg/kg',4,C2H3_S)
607         call write_archive(nid,ntime,'C2H4_up',
608     .              'C2H4 in upper atmosphere','kg/kg',4,C2H4_S)
609         call write_archive(nid,ntime,'C2H5_up',
610     .              'C2H5 in upper atmosphere','kg/kg',4,C2H5_S)
611         call write_archive(nid,ntime,'C2H6_up',
612     .              'C2H6 in upper atmosphere','kg/kg',4,C2H6_S)
613         call write_archive(nid,ntime,'C3H3_up',
614     .              'C3H3 in upper atmosphere','kg/kg',4,C3H3_S)
615         call write_archive(nid,ntime,'C3H5_up',
616     .              'C3H5 in upper atmosphere','kg/kg',4,C3H5_S)
617         call write_archive(nid,ntime,'C3H6_up',
618     .              'C3H6 in upper atmosphere','kg/kg',4,C3H6_S)
619         call write_archive(nid,ntime,'C3H7_up',
620     .              'C3H7 in upper atmosphere','kg/kg',4,C3H7_S)
621         call write_archive(nid,ntime,'C4H_up',
622     .              'C4H in upper atmosphere','kg/kg',4,C4H_S)
623         call write_archive(nid,ntime,'C4H3_up',
624     .              'C4H3 in upper atmosphere','kg/kg',4,C4H3_S)
625         call write_archive(nid,ntime,'C4H4_up',
626     .              'C4H4 in upper atmosphere','kg/kg',4,C4H4_S)
627         call write_archive(nid,ntime,'C4H2s_up',
628     .              'C4H2s in upper atmosphere','kg/kg',4,C4H2s_S)
629         call write_archive(nid,ntime,'CH2CCH2_up',
630     .              'CH2CCH2 in upper atmosphere','kg/kg',4,CH2CCH2_S)
631         call write_archive(nid,ntime,'CH3CCH_up',
632     .              'CH3CCH in upper atmosphere','kg/kg',4,CH3CCH_S)
633         call write_archive(nid,ntime,'C3H8_up',
634     .              'C3H8 in upper atmosphere','kg/kg',4,C3H8_S)
635         call write_archive(nid,ntime,'C4H2_up',
636     .              'C4H2 in upper atmosphere','kg/kg',4,C4H2_S)
637         call write_archive(nid,ntime,'C4H6_up',
638     .              'C4H6 in upper atmosphere','kg/kg',4,C4H6_S)
639         call write_archive(nid,ntime,'C4H10_up',
640     .              'C4H10 in upper atmosphere','kg/kg',4,C4H10_S)
641         call write_archive(nid,ntime,'AC6H6_up',
642     .              'AC6H6 in upper atmosphere','kg/kg',4,AC6H6_S)
643         call write_archive(nid,ntime,'C3H2_up',
644     .              'C3H2 in upper atmosphere','kg/kg',4,C3H2_S)
645         call write_archive(nid,ntime,'C4H5_up',
646     .              'C4H5 in upper atmosphere','kg/kg',4,C4H5_S)
647         call write_archive(nid,ntime,'AC6H5_up',
648     .              'AC6H5 in upper atmosphere','kg/kg',4,AC6H5_S)
649         call write_archive(nid,ntime,'N2_up',
650     .              'N2 in upper atmosphere','kg/kg',4,N2_S)
651         call write_archive(nid,ntime,'N4S_up',
652     .              'N4S in upper atmosphere','kg/kg',4,N4S_S)
653         call write_archive(nid,ntime,'CN_up',
654     .              'CN in upper atmosphere','kg/kg',4,CN_S)
655         call write_archive(nid,ntime,'HCN_up',
656     .              'HCN in upper atmosphere','kg/kg',4,HCN_S)
657         call write_archive(nid,ntime,'H2CN_up',
658     .              'H2CN in upper atmosphere','kg/kg',4,H2CN_S)
659         call write_archive(nid,ntime,'CHCN_up',
660     .              'CHCN in upper atmosphere','kg/kg',4,CHCN_S)
661         call write_archive(nid,ntime,'CH2CN_up',
662     .              'CH2CN in upper atmosphere','kg/kg',4,CH2CN_S)
663         call write_archive(nid,ntime,'CH3CN_up',
664     .              'CH3CN in upper atmosphere','kg/kg',4,CH3CN_S)
665         call write_archive(nid,ntime,'C3N_up',
666     .              'C3N in upper atmosphere','kg/kg',4,C3N_S)
667         call write_archive(nid,ntime,'HC3N_up',
668     .              'HC3N in upper atmosphere','kg/kg',4,HC3N_S)
669         call write_archive(nid,ntime,'NCCN_up',
670     .              'NCCN in upper atmosphere','kg/kg',4,NCCN_S)
671         call write_archive(nid,ntime,'C4N2_up',
672     .              'C4N2 in upper atmosphere','kg/kg',4,C4N2_S)
673      ENDIF
674
[711]675c Fin
676c-----------------------------------------------------------------------
677      ierr=NF_CLOSE(nid)
678
[1216]679      write(*,*) "start2archive: All is well that ends well."
680
[711]681      end
Note: See TracBrowser for help on using the repository browser.