source: trunk/LMDZ.COMMON/libf/dynphy_lonlat/phytitan/ini_archive.F @ 1540

Last change on this file since 1540 was 1443, checked in by emillour, 9 years ago

Titan and Venus GCMs:
Follow-up to the changes in dynamics/physics interface: ener.h, logic.h, serre.h and temps.h are now modules.
EM

File size: 10.7 KB
Line 
1c=======================================================================
2      subroutine ini_archive(nid,phis,tab_cntrl_dyn,tab_cntrl_fi)
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c   Objet:  ecriture de l'entete du fichier "start_archive"
10c   -----
11c
12c        Proche de iniwrite.F
13c
14c   Arguments:
15c   ---------
16c
17c       Inputs:
18c   ------
19c
20c       nid            unite logique du fichier "start_archive"
21c       phis           geopotentiel au sol
22c       tab_cntrl_dyn  tableau des param dynamiques
23c       tab_cntrl_fi   tableau des param physiques
24c
25
26c=======================================================================
27 
28      USE control_mod
29      USE comconst_mod
30      USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig,
31     .                       aps,bps,scaleheight,pseudoalt,
32     .                       disvert_type,pressure_exner
33
34      implicit none
35
36#include "dimensions.h"
37#include "paramet.h"
38#include "comgeom.h"
39#include "description.h"
40#include "netcdf.inc"
41
42c-----------------------------------------------------------------------
43c   Declarations
44c-----------------------------------------------------------------------
45
46c   Local:
47c   ------
48      INTEGER   length,l
49      parameter (length = 100)
50      REAL      tab_cntrl(2*length) ! tableau des parametres du run
51      INTEGER   loop
52      INTEGER   ierr, setvdim, putvdim, putdat, setname,cluvdb
53      INTEGER   setdim
54      INTEGER   ind1,indlast
55
56c   Arguments:
57c   ----------
58      REAL      phis(ip1jmp1)
59      REAL      tab_cntrl_dyn(length)
60      REAL      tab_cntrl_fi(length)
61
62!Mars --------Ajouts-----------
63c   Variables locales pour NetCDF:
64c
65      INTEGER dims2(2), dims3(3), dims4(4)
66      INTEGER idim_index
67      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
68      INTEGER idim_llmp1,idim_llm
69      INTEGER idim_tim
70      INTEGER nid,nvarid
71      real sig_s(llm),s(llm)
72
73      pi  = 2. * ASIN(1.)
74
75
76c-----------------------------------------------------------------------
77c   Remplissage du tableau des parametres de controle du RUN 
78c-----------------------------------------------------------------------
79
80      DO l=1,length
81         tab_cntrl(l)       = tab_cntrl_dyn(l)
82         tab_cntrl(length+l)= tab_cntrl_fi(l)
83      ENDDO
84
85c=======================================================================
86c       Ecriture NetCDF de l''entete du fichier "start_archive"
87c=======================================================================
88
89c
90c Preciser quelques attributs globaux:
91c
92      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
93     .                       "Fichier start_archive")
94c
95c Definir les dimensions du fichiers:
96c
97c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
98      ierr = NF_DEF_DIM (nid,"index", 2*length, idim_index)
99      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
100      ierr = NF_DEF_DIM (nid,"rlatu", jjp1, idim_rlatu)
101      ierr = NF_DEF_DIM (nid,"rlonv", iip1, idim_rlonv)
102      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
103      ierr = NF_DEF_DIM (nid,"sigs",  llm, idim_llm)
104      ierr = NF_DEF_DIM (nid,"sig", llmp1, idim_llmp1)
105      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
106
107c
108      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
109
110c-----------------------------------------------------------------------
111c  Ecriture du tableau des parametres du run
112c-----------------------------------------------------------------------
113
114      call def_var(nid,"Time","Time","days since 00:00:00",1,
115     .            idim_tim,nvarid,ierr)
116
117      ierr = NF_REDEF (nid)
118#ifdef NC_DOUBLE
119      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
120#else
121      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
122#endif
123      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
124     .                       "Parametres de controle")
125      ierr = NF_ENDDEF(nid)
126#ifdef NC_DOUBLE
127      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
128#else
129      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
130#endif
131
132c-----------------------------------------------------------------------
133c  Ecriture des longitudes et latitudes
134c-----------------------------------------------------------------------
135
136      ierr = NF_REDEF (nid)
137#ifdef NC_DOUBLE
138      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
139#else
140      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
141#endif
142      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
143     .                       "Longitudes des points U")
144      ierr = NF_ENDDEF(nid)
145#ifdef NC_DOUBLE
146      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
147#else
148      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
149#endif
150c
151      ierr = NF_REDEF (nid)
152#ifdef NC_DOUBLE
153      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
154#else
155      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
156#endif
157      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
158     .                       "Latitudes des points U")
159      ierr = NF_ENDDEF(nid)
160#ifdef NC_DOUBLE
161      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
162#else
163      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
164#endif
165c
166      ierr = NF_REDEF (nid)
167#ifdef NC_DOUBLE
168      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
169#else
170      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
171#endif
172      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
173     .                       "Longitudes des points V")
174      ierr = NF_ENDDEF(nid)
175#ifdef NC_DOUBLE
176      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
177#else
178      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
179#endif
180c
181      ierr = NF_REDEF (nid)
182#ifdef NC_DOUBLE
183      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
184#else
185      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
186#endif
187      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
188     .                       "Latitudes des points V")
189      ierr = NF_ENDDEF(nid)
190#ifdef NC_DOUBLE
191      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
192#else
193      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
194#endif
195
196c-----------------------------------------------------------------------
197c  Ecriture des niveaux verticaux
198c-----------------------------------------------------------------------
199
200      ierr = NF_REDEF (nid)
201#ifdef NC_DOUBLE
202      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_llm,nvarid)
203#else
204      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_llm,nvarid)
205#endif
206      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
207     .                       "Numero naturel des couches s")
208      ierr = NF_ENDDEF(nid)
209#ifdef NC_DOUBLE
210      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
211#else
212      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
213#endif
214c
215      ierr = NF_REDEF (nid)
216#ifdef NC_DOUBLE
217      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_llmp1,nvarid)
218#else
219      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_llmp1,nvarid)
220#endif
221      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
222     .                       "Numero naturel des couches sigma")
223      ierr = NF_ENDDEF(nid)
224#ifdef NC_DOUBLE
225      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
226#else
227      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
228#endif
229c
230      ierr = NF_REDEF (nid)
231#ifdef NC_DOUBLE
232      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
233#else
234      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
235#endif
236      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
237     .                       "Coef A: niveaux pression hybride")
238      ierr = NF_ENDDEF(nid)
239#ifdef NC_DOUBLE
240      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
241#else
242      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
243#endif
244c
245      ierr = NF_REDEF (nid)
246#ifdef NC_DOUBLE
247      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
248#else
249      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
250#endif
251      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
252     .                       "Coefficient B niveaux sigma hybride")
253      ierr = NF_ENDDEF(nid)
254#ifdef NC_DOUBLE
255      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
256#else
257      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
258#endif
259c
260c ----------------------
261      ierr = NF_REDEF (nid)
262#ifdef NC_DOUBLE
263      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
264#else
265      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
266#endif
267      ierr = NF_ENDDEF(nid)
268#ifdef NC_DOUBLE
269      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
270#else
271      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
272#endif
273
274c-----------------------------------------------------------------------
275c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
276c-----------------------------------------------------------------------
277
278      ierr = NF_REDEF (nid)
279      dims2(1) = idim_rlonu
280      dims2(2) = idim_rlatu
281#ifdef NC_DOUBLE
282      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
283#else
284      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
285#endif
286      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
287     .                       "Coefficient de passage pour U")
288      ierr = NF_ENDDEF(nid)
289#ifdef NC_DOUBLE
290      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
291#else
292      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
293#endif
294c
295      ierr = NF_REDEF (nid)
296      dims2(1) = idim_rlonv
297      dims2(2) = idim_rlatv
298#ifdef NC_DOUBLE
299      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
300#else
301      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
302#endif
303      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
304     .                       "Coefficient de passage pour V")
305      ierr = NF_ENDDEF(nid)
306#ifdef NC_DOUBLE
307      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
308#else
309      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
310#endif
311c
312c Aire de chaque maille:
313c
314      ierr = NF_REDEF (nid)
315      dims2(1) = idim_rlonv
316      dims2(2) = idim_rlatu
317#ifdef NC_DOUBLE
318      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
319#else
320      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
321#endif
322      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
323     .                       "Aires de chaque maille")
324      ierr = NF_ENDDEF(nid)
325#ifdef NC_DOUBLE
326      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
327#else
328      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
329#endif
330
331c-----------------------------------------------------------------------
332c  Ecriture du geopentiel au sol
333c-----------------------------------------------------------------------
334
335      ierr = NF_REDEF (nid)
336      dims2(1) = idim_rlonv
337      dims2(2) = idim_rlatu
338#ifdef NC_DOUBLE
339      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
340#else
341      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
342#endif
343      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
344     .                       "Geopotentiel au sol")
345      ierr = NF_ENDDEF(nid)
346#ifdef NC_DOUBLE
347      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
348#else
349      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
350#endif
351
352      RETURN
353      END
Note: See TracBrowser for help on using the repository browser.