Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

dynredem.F @ 3558

Last change on this file since 3558 was 57, checked in by aslmd, 15 years ago
mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)
File size: 19.9 KB

Line
1	SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
2	IMPLICIT NONE
3	c=======================================================================
4	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
5	c=======================================================================
6	c Declarations:
7	c -------------
8	#include "dimensions.h"
9	#include "paramet.h"
10	#include "comconst.h"
11	#include "comvert.h"
12	#include "comgeom.h"
13	#include "temps.h"
14	#include "ener.h"
15	#include "logic.h"
16	#include "netcdf.inc"
17	#include "description.h"
18	#include "serre.h"
19
20	c Arguments:
21	c ----------
22	INTEGER*4 idayref,anneeref
23	REAL phis(ip1jmp1)
24	CHARACTER() fichnom
25	INTEGER nq
26
27	c Local:
28	c ------
29	INTEGER iq,l
30	CHARACTER str3*3
31	INTEGER length
32	PARAMETER (length = 100)
33	REAL tab_cntrl(length) ! tableau des parametres du run
34	INTEGER ierr
35	character*20 modname
36	character*80 abort_message
37
38	c Variables locales pour NetCDF:
39	c
40	INTEGER dims2(2), dims3(3), dims4(4)
41	INTEGER idim_index
42	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
43	INTEGER idim_llm, idim_llmp1
44	INTEGER idim_tim
45	INTEGER nid,nvarid
46
47	REAL zan0,zjulian,hours
48	REAL sigs(llm)
49	INTEGER yyears0,jjour0, mmois0
50	character*30 unites
51
52
53	c-----------------------------------------------------------------------
54	modname='dynredem'
55	do l=1,llm
56	sigs(l)=float(l)
57	enddo
58
59	DO l=1,length
60	tab_cntrl(l) = 0.
61	ENDDO
62	tab_cntrl(1) = FLOAT(iim)
63	tab_cntrl(2) = FLOAT(jjm)
64	tab_cntrl(3) = FLOAT(llm)
65	tab_cntrl(4) = FLOAT(idayref)
66	tab_cntrl(5) = rad
67	tab_cntrl(6) = omeg
68	tab_cntrl(7) = g
69	tab_cntrl(8) = cpp
70	tab_cntrl(9) = kappa
71	tab_cntrl(10) = daysec
72	tab_cntrl(11) = dtvr
73	tab_cntrl(12) = etot0
74	tab_cntrl(13) = ptot0
75	tab_cntrl(14) = ztot0
76	tab_cntrl(15) = stot0
77	tab_cntrl(16) = ang0
78	tab_cntrl(17) = pa
79	tab_cntrl(18) = preff
80	c
81	c ..... parametres pour le zoom ......
82
83	tab_cntrl(19) = clon
84	tab_cntrl(20) = clat
85	tab_cntrl(21) = grossismx
86	tab_cntrl(22) = grossismy
87	c
88	IF ( fxyhypb ) THEN
89	tab_cntrl(23) = 1.
90	tab_cntrl(24) = dzoomx
91	tab_cntrl(25) = dzoomy
92	tab_cntrl(26) = 0.
93	tab_cntrl(27) = taux
94	tab_cntrl(28) = tauy
95	ELSE
96	tab_cntrl(23) = 0.
97	tab_cntrl(24) = dzoomx
98	tab_cntrl(25) = dzoomy
99	tab_cntrl(26) = 0.
100	tab_cntrl(27) = 0.
101	tab_cntrl(28) = 0.
102	IF( ysinus ) tab_cntrl(26) = 1.
103	ENDIF
104	c
105	c .........................................................
106	c
107	c Creation du fichier:
108	c
109	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
110	IF (ierr.NE.NF_NOERR) THEN
111	WRITE(6,*)" Pb d ouverture du fichier "//fichnom
112	WRITE(6,*)' ierr = ', ierr
113	CALL ABORT
114	ENDIF
115	c
116	c Preciser quelques attributs globaux:
117	c
118	ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
119	. "Dynamic start file")
120	c
121	c Definir les dimensions du fichiers:
122	c
123	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
124	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
125	ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
126	ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
127	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
128	ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
129	ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
130	ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
131
132	c CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
133	c ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
134	c ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
135	c ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
136	c
137	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
138	c
139	c Definir et enregistrer certains champs invariants:
140	c
141	c ----------------------
142	ierr = NF_REDEF (nid)
143	#ifdef NC_DOUBLE
144	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
145	#else
146	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
147	#endif
148	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
149	. "Parametres de controle")
150	ierr = NF_ENDDEF(nid)
151	#ifdef NC_DOUBLE
152	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
153	#else
154	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
155	#endif
156	c
157	c ----------------------
158	ierr = NF_REDEF (nid)
159	#ifdef NC_DOUBLE
160	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
161	#else
162	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
163	#endif
164	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
165	. "Longitudes des points U")
166	ierr = NF_ENDDEF(nid)
167	#ifdef NC_DOUBLE
168	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
169	#else
170	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
171	#endif
172	c
173	c ----------------------
174	ierr = NF_REDEF (nid)
175	#ifdef NC_DOUBLE
176	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
177	#else
178	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
179	#endif
180	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
181	. "Latitudes des points U")
182	ierr = NF_ENDDEF(nid)
183	#ifdef NC_DOUBLE
184	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
185	#else
186	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
187	#endif
188	c
189	c ----------------------
190	ierr = NF_REDEF (nid)
191	#ifdef NC_DOUBLE
192	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
193	#else
194	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
195	#endif
196	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
197	. "Longitudes des points V")
198	ierr = NF_ENDDEF(nid)
199	#ifdef NC_DOUBLE
200	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
201	#else
202	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
203	#endif
204	c
205	c ----------------------
206	ierr = NF_REDEF (nid)
207	#ifdef NC_DOUBLE
208	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
209	#else
210	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
211	#endif
212	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
213	. "Latitudes des points V")
214	ierr = NF_ENDDEF(nid)
215	#ifdef NC_DOUBLE
216	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
217	#else
218	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
219	#endif
220	c
221	c ----------------------
222	ierr = NF_REDEF (nid)
223	#ifdef NC_DOUBLE
224	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
225	#else
226	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
227	#endif
228	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
229	. "Coef A: hybrid pressure levels" )
230	ierr = NF_ENDDEF(nid)
231	#ifdef NC_DOUBLE
232	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
233	#else
234	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
235	#endif
236	c
237	c ----------------------
238	ierr = NF_REDEF (nid)
239	#ifdef NC_DOUBLE
240	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
241	#else
242	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
243	#endif
244	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
245	. "Coef B: hybrid sigma levels")
246	ierr = NF_ENDDEF(nid)
247	#ifdef NC_DOUBLE
248	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
249	#else
250	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
251	#endif
252	c
253	c ----------------------
254	ierr = NF_REDEF (nid)
255	#ifdef NC_DOUBLE
256	ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
257	#else
258	ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
259	#endif
260	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
261	. "Coef AS: hybrid pressure in midlayers")
262	ierr = NF_ENDDEF(nid)
263	#ifdef NC_DOUBLE
264	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
265	#else
266	ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
267	#endif
268	c
269	c ----------------------
270	ierr = NF_REDEF (nid)
271	#ifdef NC_DOUBLE
272	ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
273	#else
274	ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
275	#endif
276	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 31,
277	. "Coef BS: hybrid sigma midlayers")
278	ierr = NF_ENDDEF(nid)
279	#ifdef NC_DOUBLE
280	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
281	#else
282	ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
283	#endif
284	c
285	c ----------------------
286	ierr = NF_REDEF (nid)
287	#ifdef NC_DOUBLE
288	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
289	#else
290	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
291	#endif
292	ierr = NF_ENDDEF(nid)
293	#ifdef NC_DOUBLE
294	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
295	#else
296	ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
297	#endif
298	c ------------------------------------------------------------------
299	c ------------------------------------------------------------------
300	c Variable uniquement pour visualisation avec Grads ou Ferret
301	c ------------------------------------------------------------------
302	ierr = NF_REDEF (nid)
303	#ifdef NC_DOUBLE
304	ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
305	#else
306	ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
307	#endif
308	ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
309	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
310	. "North latitude")
311	ierr = NF_ENDDEF(nid)
312	#ifdef NC_DOUBLE
313	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
314	#else
315	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
316	#endif
317	c ----------------------
318	ierr = NF_REDEF (nid)
319	#ifdef NC_DOUBLE
320	ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
321	#else
322	ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
323	#endif
324	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
325	. "East longitude")
326	ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
327	ierr = NF_ENDDEF(nid)
328	#ifdef NC_DOUBLE
329	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
330	#else
331	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
332	#endif
333	c --------------------------
334	ierr = NF_REDEF (nid)
335	#ifdef NC_DOUBLE
336	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
337	. idim_llm,nvarid)
338	#else
339	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
340	. idim_llm,nvarid)
341	#endif
342	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
343	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
344	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
345
346	ierr = NF_ENDDEF(nid)
347	#ifdef NC_DOUBLE
348	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
349	#else
350	ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
351	#endif
352
353
354	c ----------------------
355	c ----------------------
356	c
357	c Coefficients de passage cov. <-> contra. <--> naturel
358	c
359	ierr = NF_REDEF (nid)
360	dims2(1) = idim_rlonu
361	dims2(2) = idim_rlatu
362	#ifdef NC_DOUBLE
363	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
364	#else
365	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
366	#endif
367	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
368	. "Coefficient de passage pour U")
369	ierr = NF_ENDDEF(nid)
370	#ifdef NC_DOUBLE
371	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
372	#else
373	ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
374	#endif
375	c
376	c ----------------------
377	ierr = NF_REDEF (nid)
378	dims2(1) = idim_rlonv
379	dims2(2) = idim_rlatv
380	#ifdef NC_DOUBLE
381	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
382	#else
383	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
384	#endif
385	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
386	. "Coefficient de passage pour V")
387	ierr = NF_ENDDEF(nid)
388	#ifdef NC_DOUBLE
389	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
390	#else
391	ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
392	#endif
393	c
394	c ----------------------
395	c Aire de chaque maille:
396	c
397	ierr = NF_REDEF (nid)
398	dims2(1) = idim_rlonv
399	dims2(2) = idim_rlatu
400	#ifdef NC_DOUBLE
401	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
402	#else
403	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
404	#endif
405	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
406	. "Aires de chaque maille")
407	ierr = NF_ENDDEF(nid)
408	#ifdef NC_DOUBLE
409	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
410	#else
411	ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
412	#endif
413	c
414	c ----------------------
415	c Geopentiel au sol:
416	c
417	ierr = NF_REDEF (nid)
418	dims2(1) = idim_rlonv
419	dims2(2) = idim_rlatu
420	#ifdef NC_DOUBLE
421	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
422	#else
423	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
424	#endif
425	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
426	. "Geopotentiel au sol")
427	ierr = NF_ENDDEF(nid)
428	#ifdef NC_DOUBLE
429	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
430	#else
431	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
432	#endif
433	c
434	c ----------------------
435	c Definir les variables pour pouvoir les enregistrer plus tard:
436	c
437	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
438	c
439	#ifdef NC_DOUBLE
440	ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
441	#else
442	ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
443	#endif
444	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
445	. "Temps de simulation")
446	write(unites,200)yyears0,mmois0,jjour0
447	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
448	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
449	. unites)
450
451	c
452	dims4(1) = idim_rlonu
453	dims4(2) = idim_rlatu
454	dims4(3) = idim_llm
455	dims4(4) = idim_tim
456	#ifdef NC_DOUBLE
457	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
458	#else
459	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
460	#endif
461	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
462	. "Vitesse U")
463	c
464	dims4(1) = idim_rlonv
465	dims4(2) = idim_rlatv
466	dims4(3) = idim_llm
467	dims4(4) = idim_tim
468	#ifdef NC_DOUBLE
469	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
470	#else
471	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
472	#endif
473	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
474	. "Vitesse V")
475	c
476	dims4(1) = idim_rlonv
477	dims4(2) = idim_rlatu
478	dims4(3) = idim_llm
479	dims4(4) = idim_tim
480	#ifdef NC_DOUBLE
481	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
482	#else
483	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
484	#endif
485	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
486	. "Temperature")
487	c
488	dims4(1) = idim_rlonv
489	dims4(2) = idim_rlatu
490	dims4(3) = idim_llm
491	dims4(4) = idim_tim
492	IF(nq.GE.1) THEN
493	DO iq=1,nq
494	IF (iq.GT.99) THEN
495	PRINT*, "Trop de traceurs"
496	CALL abort
497	ELSE
498	str3(1:1)='q'
499	WRITE(str3(2:3),'(i2.2)') iq
500	#ifdef NC_DOUBLE
501	ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
502	#else
503	ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
504	#endif
505	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
506	. "Traceurs "//str3)
507	ENDIF
508	ENDDO
509	ENDIF
510	c
511	dims4(1) = idim_rlonv
512	dims4(2) = idim_rlatu
513	dims4(3) = idim_llm
514	dims4(4) = idim_tim
515	#ifdef NC_DOUBLE
516	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
517	#else
518	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
519	#endif
520	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
521	. "C est quoi ?")
522	c
523	dims3(1) = idim_rlonv
524	dims3(2) = idim_rlatu
525	dims3(3) = idim_tim
526	#ifdef NC_DOUBLE
527	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
528	#else
529	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
530	#endif
531	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
532	. "Pression au sol")
533	c
534	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
535	ierr = NF_CLOSE(nid) ! fermer le fichier
536
537	PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
538	PRINT*,'rad,omeg,g,cpp,kappa',
539	, rad,omeg,g,cpp,kappa
540
541	RETURN
542	END
543
544	c ================================================================
545	SUBROUTINE dynredem1(fichnom,time,
546	. vcov,ucov,teta,q,nq,masse,ps)
547	IMPLICIT NONE
548	c=================================================================
549	c Ecriture du fichier de redemarrage sous format NetCDF
550	c=================================================================
551	#include "dimensions.h"
552	#include "paramet.h"
553	#include "description.h"
554	#include "netcdf.inc"
555	#include "comvert.h"
556	#include "comgeom.h"
557
558	INTEGER nq, l
559	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
560	REAL teta(ip1jmp1,llm)
561	REAL ps(ip1jmp1),masse(ip1jmp1,llm)
562	REAL q(iip1,jjp1,llm,nqmx)
563	REAL q3d(iip1,jjp1,llm) !temporary variable
564	CHARACTER() fichnom
565
566	REAL time
567	INTEGER nid, nvarid
568	INTEGER ierr
569	INTEGER iq
570	CHARACTER str3*3
571	character*20 modname
572	character*80 abort_message
573	c
574	INTEGER nb,i,j
575	SAVE nb
576	DATA nb / 0 /
577
578	modname = 'dynredem1'
579	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
580	IF (ierr .NE. NF_NOERR) THEN
581	PRINT*, "Pb. d ouverture "//fichnom
582	CALL abort
583	ENDIF
584
585	c Ecriture/extension de la coordonnee temps
586
587	nb = nb + 1
588	ierr = NF_INQ_VARID(nid, "Time", nvarid)
589	IF (ierr .NE. NF_NOERR) THEN
590	print *, NF_STRERROR(ierr)
591	abort_message='Variable Time n est pas definie'
592	CALL abort_gcm(modname,abort_message,ierr)
593	ENDIF
594	#ifdef NC_DOUBLE
595	ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
596	#else
597	ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
598	#endif
599	PRINT*, "Enregistrement pour ", nb, time
600
601	c Ecriture des champs
602	c
603	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
604	IF (ierr .NE. NF_NOERR) THEN
605	PRINT*, "Variable ucov n est pas definie"
606	CALL abort
607	ENDIF
608	#ifdef NC_DOUBLE
609	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
610	#else
611	ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
612	#endif
613
614	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
615	IF (ierr .NE. NF_NOERR) THEN
616	PRINT*, "Variable vcov n est pas definie"
617	CALL abort
618	ENDIF
619	#ifdef NC_DOUBLE
620	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
621	#else
622	ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
623	#endif
624
625	ierr = NF_INQ_VARID(nid, "teta", nvarid)
626	IF (ierr .NE. NF_NOERR) THEN
627	PRINT*, "Variable teta n est pas definie"
628	CALL abort
629	ENDIF
630	#ifdef NC_DOUBLE
631	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
632	#else
633	ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
634	#endif
635
636	IF (nq.GT.99) THEN
637	PRINT*, "Trop de traceurs"
638	CALL abort
639	ENDIF
640	IF(nq.GE.1) THEN
641	DO iq=1,nq
642	str3(1:1)='q'
643	WRITE(str3(2:3),'(i2.2)') iq
644	ierr = NF_INQ_VARID(nid, str3, nvarid)
645	IF (ierr .NE. NF_NOERR) THEN
646	PRINT*, "Variable "//str3//" n est pas definie"
647	CALL abort
648	ENDIF
649	do l=1,llm
650	do j=1,jjp1
651	do i=1,iip1
652	q3d(i,j,l)=q(i,j,l,iq)
653	enddo
654	enddo
655	enddo
656	#ifdef NC_DOUBLE
657	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
658	#else
659	ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
660	#endif
661	IF (ierr .NE. NF_NOERR) THEN
662	PRINT*, "Error: ", NF_STRERROR(ierr)
663	CALL abort
664	ENDIF
665	ENDDO
666	ENDIF
667	c
668	ierr = NF_INQ_VARID(nid, "masse", nvarid)
669	IF (ierr .NE. NF_NOERR) THEN
670	PRINT*, "Variable masse n est pas definie"
671	CALL abort
672	ENDIF
673	#ifdef NC_DOUBLE
674	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
675	#else
676	ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
677	#endif
678	c
679	ierr = NF_INQ_VARID(nid, "ps", nvarid)
680	IF (ierr .NE. NF_NOERR) THEN
681	PRINT*, "Variable ps n est pas definie"
682	CALL abort
683	ENDIF
684	#ifdef NC_DOUBLE
685	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
686	#else
687	ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
688	#endif
689
690	ierr = NF_CLOSE(nid)
691	c
692	RETURN
693	END
694

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format