Context Navigation

dynredem.F @ 802

Last change on this file since 802 was 690, checked in by lmdzadmin, 19 years ago
Correction bogue : on ecrit dorenavant en DOUBLE precision dans le restart.nc IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 18.1 KB

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

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

Download in other formats:

Original Format