Context Navigation

dynredem.F @ 1198

Last change on this file since 1198 was 845, checked in by Laurent Fairhead, 17 years ago

Création de la branche LMDZ4_V3_patches: à partir de la version de référence LMDZ4_V3,

on corrige différents bugs qui sont sur la branche de développement HEAD pour établir
une version de référence LMDZ4_V3 pour les utilisateurs non-développeurs

Cette branche ne servira que pour les corrections de bugs et les version y seront tagguées

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 20.5 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, nid_trac, nvarid_trac
533	REAL trac_tmp(ip1jmp1,llm)
534	INTEGER ierr, ierr_file
535	INTEGER iq
536	INTEGER length
537	PARAMETER (length = 100)
538	REAL tab_cntrl(length) ! tableau des parametres du run
539	character*20 modname
540	character*80 abort_message
541	c
542	INTEGER nb
543	SAVE nb
544	DATA nb / 0 /
545
546	modname = 'dynredem1'
547	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
548	IF (ierr .NE. NF_NOERR) THEN
549	PRINT*, "Pb. d ouverture "//fichnom
550	CALL abort
551	ENDIF
552
553	c Ecriture/extension de la coordonnee temps
554
555	nb = nb + 1
556	ierr = NF_INQ_VARID(nid, "temps", nvarid)
557	IF (ierr .NE. NF_NOERR) THEN
558	print *, NF_STRERROR(ierr)
559	abort_message='Variable temps n est pas definie'
560	CALL abort_gcm(modname,abort_message,ierr)
561	ENDIF
562	#ifdef NC_DOUBLE
563	ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
564	#else
565	ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
566	#endif
567	PRINT*, "Enregistrement pour ", nb, time
568
569	c
570	c Re-ecriture du tableau de controle, itaufin n'est plus defini quand
571	c on passe dans dynredem0
572	ierr = NF_INQ_VARID (nid, "controle", nvarid)
573	IF (ierr .NE. NF_NOERR) THEN
574	abort_message="dynredem1: Le champ <controle> est absent"
575	ierr = 1
576	CALL abort_gcm(modname,abort_message,ierr)
577	ENDIF
578	#ifdef NC_DOUBLE
579	ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
580	#else
581	ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
582	#endif
583	tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
584	#ifdef NC_DOUBLE
585	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
586	#else
587	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
588	#endif
589
590	c Ecriture des champs
591	c
592	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
593	IF (ierr .NE. NF_NOERR) THEN
594	PRINT*, "Variable ucov n est pas definie"
595	CALL abort
596	ENDIF
597	#ifdef NC_DOUBLE
598	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
599	#else
600	ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
601	#endif
602
603	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
604	IF (ierr .NE. NF_NOERR) THEN
605	PRINT*, "Variable vcov n est pas definie"
606	CALL abort
607	ENDIF
608	#ifdef NC_DOUBLE
609	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
610	#else
611	ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
612	#endif
613
614	ierr = NF_INQ_VARID(nid, "teta", nvarid)
615	IF (ierr .NE. NF_NOERR) THEN
616	PRINT*, "Variable teta n est pas definie"
617	CALL abort
618	ENDIF
619	#ifdef NC_DOUBLE
620	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
621	#else
622	ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
623	#endif
624
625	#ifdef INCA
626	! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
627	ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
628	IF (ierr_file .NE.NF_NOERR) THEN
629	write(6,*)' Pb d''ouverture du fichier start_trac.nc'
630	write(6,*)' ierr = ', ierr_file
631	ENDIF
632	#endif
633
634	IF(nq.GE.1) THEN
635	do iq=1,nq
636	#ifdef INCA
637	! lecture de la valeur du traceur dans start_trac.nc
638	if (ierr_file .ne. 2) then
639	ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
640	IF (ierr .NE. NF_NOERR) THEN
641	PRINT*, tname(iq),"est absent de start_trac.nc"
642	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
643	IF (ierr .NE. NF_NOERR) THEN
644	PRINT*, "Variable ", tname(iq)," n est pas definie"
645	CALL abort
646	ENDIF
647	#ifdef NC_DOUBLE
648	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
649	#else
650	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
651	#endif
652
653	ELSE
654	PRINT*, tname(iq), "est present dans start_trac.nc"
655	#ifdef NC_DOUBLE
656	ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
657	#else
658	ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp)
659	#endif
660	IF (ierr .NE. NF_NOERR) THEN
661	PRINT*, "Lecture echouee pour", tname(iq)
662	CALL abort
663	ENDIF
664	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
665	IF (ierr .NE. NF_NOERR) THEN
666	PRINT*, "Variable ", tname(iq)," n est pas definie"
667	CALL abort
668	ENDIF
669	#ifdef NC_DOUBLE
670	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)
671	#else
672	ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)
673	#endif
674
675	ENDIF
676	! fin lecture du traceur
677	ELSE ! si il n'y a pas de fichier start_trac.nc
678	! print *, 'il n y a pas de fichier start_trac'
679	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
680	IF (ierr .NE. NF_NOERR) THEN
681	PRINT*, "Variable tname(iq) n est pas definie"
682	CALL abort
683	ENDIF
684	#ifdef NC_DOUBLE
685	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
686	#else
687	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
688	#endif
689	ENDIF
690	! endif ifdef INCA
691	#endif
692
693	#ifndef INCA
694	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
695	IF (ierr .NE. NF_NOERR) THEN
696	PRINT*, "Variable tname(iq) n est pas definie"
697	CALL abort
698	ENDIF
699	#ifdef NC_DOUBLE
700	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
701	#else
702	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
703	#endif
704	! endif ifndef INCA
705	#endif
706	ENDDO
707	ENDIF
708	c
709	ierr = NF_INQ_VARID(nid, "masse", nvarid)
710	IF (ierr .NE. NF_NOERR) THEN
711	PRINT*, "Variable masse n est pas definie"
712	CALL abort
713	ENDIF
714	#ifdef NC_DOUBLE
715	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
716	#else
717	ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
718	#endif
719	c
720	ierr = NF_INQ_VARID(nid, "ps", nvarid)
721	IF (ierr .NE. NF_NOERR) THEN
722	PRINT*, "Variable ps n est pas definie"
723	CALL abort
724	ENDIF
725	#ifdef NC_DOUBLE
726	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
727	#else
728	ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
729	#endif
730
731	ierr = NF_CLOSE(nid)
732	c
733	RETURN
734	END
735

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

Download in other formats:

Original Format