Context Navigation

dynredem.F @ 1172

Last change on this file since 1172 was 1146, checked in by Laurent Fairhead, 16 years ago
Réintegration dans le tronc des modifications issues de la branche LMDZ-dev comprises entre la révision 1074 et 1145 Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes résultats entre la trunk et la dev LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 20.7 KB

Line
1	!
2	! $Header$
3	!
4	c
5	SUBROUTINE dynredem0(fichnom,iday_end,phis)
6	USE IOIPSL
7	USE infotrac
8	IMPLICIT NONE
9	c=======================================================================
10	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
11	c=======================================================================
12	c Declarations:
13	c -------------
14	#include "dimensions.h"
15	#include "paramet.h"
16	#include "comconst.h"
17	#include "comvert.h"
18	#include "comgeom.h"
19	#include "temps.h"
20	#include "ener.h"
21	#include "logic.h"
22	#include "netcdf.inc"
23	#include "description.h"
24	#include "serre.h"
25
26	c Arguments:
27	c ----------
28	INTEGER iday_end
29	REAL phis(ip1jmp1)
30	CHARACTER() fichnom
31
32	c Local:
33	c ------
34	INTEGER iq,l
35	INTEGER length
36	PARAMETER (length = 100)
37	REAL tab_cntrl(length) ! tableau des parametres du run
38	INTEGER ierr
39	character*20 modname
40	character*80 abort_message
41
42	c Variables locales pour NetCDF:
43	c
44	INTEGER dims2(2), dims3(3), dims4(4)
45	INTEGER idim_index
46	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
47	INTEGER idim_s, idim_sig
48	INTEGER idim_tim
49	INTEGER nid,nvarid
50
51	REAL zan0,zjulian,hours
52	INTEGER yyears0,jjour0, mmois0
53	character*30 unites
54
55
56	c-----------------------------------------------------------------------
57	modname='dynredem'
58
59	call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
60	call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
61
62
63	DO l=1,length
64	tab_cntrl(l) = 0.
65	ENDDO
66	tab_cntrl(1) = FLOAT(iim)
67	tab_cntrl(2) = FLOAT(jjm)
68	tab_cntrl(3) = FLOAT(llm)
69	tab_cntrl(4) = FLOAT(day_ref)
70	tab_cntrl(5) = FLOAT(annee_ref)
71	tab_cntrl(6) = rad
72	tab_cntrl(7) = omeg
73	tab_cntrl(8) = g
74	tab_cntrl(9) = cpp
75	tab_cntrl(10) = kappa
76	tab_cntrl(11) = daysec
77	tab_cntrl(12) = dtvr
78	tab_cntrl(13) = etot0
79	tab_cntrl(14) = ptot0
80	tab_cntrl(15) = ztot0
81	tab_cntrl(16) = stot0
82	tab_cntrl(17) = ang0
83	tab_cntrl(18) = pa
84	tab_cntrl(19) = preff
85	c
86	c ..... parametres pour le zoom ......
87
88	tab_cntrl(20) = clon
89	tab_cntrl(21) = clat
90	tab_cntrl(22) = grossismx
91	tab_cntrl(23) = grossismy
92	c
93	IF ( fxyhypb ) THEN
94	tab_cntrl(24) = 1.
95	tab_cntrl(25) = dzoomx
96	tab_cntrl(26) = dzoomy
97	tab_cntrl(27) = 0.
98	tab_cntrl(28) = taux
99	tab_cntrl(29) = tauy
100	ELSE
101	tab_cntrl(24) = 0.
102	tab_cntrl(25) = dzoomx
103	tab_cntrl(26) = dzoomy
104	tab_cntrl(27) = 0.
105	tab_cntrl(28) = 0.
106	tab_cntrl(29) = 0.
107	IF( ysinus ) tab_cntrl(27) = 1.
108	ENDIF
109
110	tab_cntrl(30) = FLOAT(iday_end)
111	tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
112	c
113	c .........................................................
114	c
115	c Creation du fichier:
116	c
117	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
118	IF (ierr.NE.NF_NOERR) THEN
119	WRITE(6,*)" Pb d ouverture du fichier "//fichnom
120	WRITE(6,*)' ierr = ', ierr
121	CALL ABORT
122	ENDIF
123	c
124	c Preciser quelques attributs globaux:
125	c
126	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
127	. "Fichier demmarage dynamique")
128	c
129	c Definir les dimensions du fichiers:
130	c
131	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
132	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
133	ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
134	ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
135	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
136	ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
137	ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
138	ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
139	c
140	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
141	c
142	c Definir et enregistrer certains champs invariants:
143	c
144	ierr = NF_REDEF (nid)
145	cIM 220306 BEG
146	#ifdef NC_DOUBLE
147	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
148	#else
149	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
150	#endif
151	cIM 220306 END
152	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
153	. "Parametres de controle")
154	ierr = NF_ENDDEF(nid)
155	#ifdef NC_DOUBLE
156	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
157	#else
158	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
159	#endif
160	c
161	ierr = NF_REDEF (nid)
162	cIM 220306 BEG
163	#ifdef NC_DOUBLE
164	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
165	#else
166	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
167	#endif
168	cIM 220306 END
169	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
170	. "Longitudes des points U")
171	ierr = NF_ENDDEF(nid)
172	#ifdef NC_DOUBLE
173	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
174	#else
175	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
176	#endif
177	c
178	ierr = NF_REDEF (nid)
179	cIM 220306 BEG
180	#ifdef NC_DOUBLE
181	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
182	#else
183	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
184	#endif
185	cIM 220306 END
186	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
187	. "Latitudes des points U")
188	ierr = NF_ENDDEF(nid)
189	#ifdef NC_DOUBLE
190	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
191	#else
192	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
193	#endif
194	c
195	ierr = NF_REDEF (nid)
196	cIM 220306 BEG
197	#ifdef NC_DOUBLE
198	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
199	#else
200	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
201	#endif
202	cIM 220306 END
203	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
204	. "Longitudes des points V")
205	ierr = NF_ENDDEF(nid)
206	#ifdef NC_DOUBLE
207	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
208	#else
209	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
210	#endif
211	c
212	ierr = NF_REDEF (nid)
213	cIM 220306 BEG
214	#ifdef NC_DOUBLE
215	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
216	#else
217	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
218	#endif
219	cIM 220306 END
220	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
221	. "Latitudes des points V")
222	ierr = NF_ENDDEF(nid)
223	#ifdef NC_DOUBLE
224	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
225	#else
226	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
227	#endif
228	c
229	ierr = NF_REDEF (nid)
230	cIM 220306 BEG
231	#ifdef NC_DOUBLE
232	ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
233	#else
234	ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
235	#endif
236	cIM 220306 END
237	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
238	. "Numero naturel des couches s")
239	ierr = NF_ENDDEF(nid)
240	#ifdef NC_DOUBLE
241	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
242	#else
243	ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
244	#endif
245	c
246	ierr = NF_REDEF (nid)
247	cIM 220306 BEG
248	#ifdef NC_DOUBLE
249	ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
250	#else
251	ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
252	#endif
253	cIM 220306 END
254	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
255	. "Numero naturel des couches sigma")
256	ierr = NF_ENDDEF(nid)
257	#ifdef NC_DOUBLE
258	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
259	#else
260	ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
261	#endif
262	c
263	ierr = NF_REDEF (nid)
264	cIM 220306 BEG
265	#ifdef NC_DOUBLE
266	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
267	#else
268	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
269	#endif
270	cIM 220306 END
271	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
272	. "Coefficient A pour hybride")
273	ierr = NF_ENDDEF(nid)
274	#ifdef NC_DOUBLE
275	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
276	#else
277	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
278	#endif
279	c
280	ierr = NF_REDEF (nid)
281	cIM 220306 BEG
282	#ifdef NC_DOUBLE
283	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
284	#else
285	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
286	#endif
287	cIM 220306 END
288	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
289	. "Coefficient B pour hybride")
290	ierr = NF_ENDDEF(nid)
291	#ifdef NC_DOUBLE
292	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
293	#else
294	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
295	#endif
296	c
297	ierr = NF_REDEF (nid)
298	cIM 220306 BEG
299	#ifdef NC_DOUBLE
300	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
301	#else
302	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
303	#endif
304	cIM 220306 END
305	ierr = NF_ENDDEF(nid)
306	#ifdef NC_DOUBLE
307	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
308	#else
309	ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
310	#endif
311	c
312	c Coefficients de passage cov. <-> contra. <--> naturel
313	c
314	ierr = NF_REDEF (nid)
315	dims2(1) = idim_rlonu
316	dims2(2) = idim_rlatu
317	cIM 220306 BEG
318	#ifdef NC_DOUBLE
319	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
320	#else
321	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
322	#endif
323	cIM 220306 END
324	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
325	. "Coefficient de passage pour U")
326	ierr = NF_ENDDEF(nid)
327	#ifdef NC_DOUBLE
328	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
329	#else
330	ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
331	#endif
332	c
333	ierr = NF_REDEF (nid)
334	dims2(1) = idim_rlonv
335	dims2(2) = idim_rlatv
336	cIM 220306 BEG
337	#ifdef NC_DOUBLE
338	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
339	#else
340	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
341	#endif
342	cIM 220306 END
343	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
344	. "Coefficient de passage pour V")
345	ierr = NF_ENDDEF(nid)
346	#ifdef NC_DOUBLE
347	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
348	#else
349	ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
350	#endif
351	c
352	c Aire de chaque maille:
353	c
354	ierr = NF_REDEF (nid)
355	dims2(1) = idim_rlonv
356	dims2(2) = idim_rlatu
357	cIM 220306 BEG
358	#ifdef NC_DOUBLE
359	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
360	#else
361	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
362	#endif
363	cIM 220306 END
364	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
365	. "Aires de chaque maille")
366	ierr = NF_ENDDEF(nid)
367	#ifdef NC_DOUBLE
368	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
369	#else
370	ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
371	#endif
372	c
373	c Geopentiel au sol:
374	c
375	ierr = NF_REDEF (nid)
376	dims2(1) = idim_rlonv
377	dims2(2) = idim_rlatu
378	cIM 220306 BEG
379	#ifdef NC_DOUBLE
380	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
381	#else
382	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
383	#endif
384	cIM 220306 END
385	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
386	. "Geopotentiel au sol")
387	ierr = NF_ENDDEF(nid)
388	#ifdef NC_DOUBLE
389	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
390	#else
391	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
392	#endif
393	c
394	c Definir les variables pour pouvoir les enregistrer plus tard:
395	c
396	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
397	c
398	cIM 220306 BEG
399	#ifdef NC_DOUBLE
400	ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
401	#else
402	ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
403	#endif
404	cIM 220306 END
405	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
406	. "Temps de simulation")
407	write(unites,200)yyears0,mmois0,jjour0
408	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
409	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
410	. unites)
411
412	c
413	dims4(1) = idim_rlonu
414	dims4(2) = idim_rlatu
415	dims4(3) = idim_s
416	dims4(4) = idim_tim
417	cIM 220306 BEG
418	#ifdef NC_DOUBLE
419	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
420	#else
421	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
422	#endif
423	cIM 220306 END
424	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
425	. "Vitesse U")
426	c
427	dims4(1) = idim_rlonv
428	dims4(2) = idim_rlatv
429	dims4(3) = idim_s
430	dims4(4) = idim_tim
431	cIM 220306 BEG
432	#ifdef NC_DOUBLE
433	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
434	#else
435	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
436	#endif
437	cIM 220306 END
438	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
439	. "Vitesse V")
440	c
441	dims4(1) = idim_rlonv
442	dims4(2) = idim_rlatu
443	dims4(3) = idim_s
444	dims4(4) = idim_tim
445	cIM 220306 BEG
446	#ifdef NC_DOUBLE
447	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
448	#else
449	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
450	#endif
451	cIM 220306 END
452	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
453	. "Temperature")
454	c
455	dims4(1) = idim_rlonv
456	dims4(2) = idim_rlatu
457	dims4(3) = idim_s
458	dims4(4) = idim_tim
459	IF(nqtot.GE.1) THEN
460	DO iq=1,nqtot
461	cIM 220306 BEG
462	#ifdef NC_DOUBLE
463	ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
464	#else
465	ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
466	#endif
467	cIM 220306 END
468	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
469	ENDDO
470	ENDIF
471	c
472	dims4(1) = idim_rlonv
473	dims4(2) = idim_rlatu
474	dims4(3) = idim_s
475	dims4(4) = idim_tim
476	cIM 220306 BEG
477	#ifdef NC_DOUBLE
478	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
479	#else
480	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
481	#endif
482	cIM 220306 END
483	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
484	. "C est quoi ?")
485	c
486	dims3(1) = idim_rlonv
487	dims3(2) = idim_rlatu
488	dims3(3) = idim_tim
489	cIM 220306 BEG
490	#ifdef NC_DOUBLE
491	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
492	#else
493	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
494	#endif
495	cIM 220306 END
496	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
497	. "Pression au sol")
498	c
499	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
500	ierr = NF_CLOSE(nid) ! fermer le fichier
501
502	PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
503	PRINT*,'rad,omeg,g,cpp,kappa',
504	, rad,omeg,g,cpp,kappa
505
506	RETURN
507	END
508	SUBROUTINE dynredem1(fichnom,time,
509	. vcov,ucov,teta,q,masse,ps)
510	USE infotrac
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 "temps.h"
522	#include "control.h"
523
524	INTEGER 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,nqtot)
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	IF (config_inca /= 'none') THEN
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	END IF
633
634	IF(nqtot.GE.1) THEN
635	do iq=1,nqtot
636
637	IF (config_inca == 'none') THEN
638	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
639	IF (ierr .NE. NF_NOERR) THEN
640	PRINT*, "Variable tname(iq) n est pas definie"
641	CALL abort
642	ENDIF
643	#ifdef NC_DOUBLE
644	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
645	#else
646	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
647	#endif
648	ELSE ! config_inca = 'chem' ou 'aero'
649	! lecture de la valeur du traceur dans start_trac.nc
650	IF (ierr_file .ne. 2) THEN
651	ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
652	IF (ierr .NE. NF_NOERR) THEN
653	PRINT*, tname(iq),"est absent de start_trac.nc"
654	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
655	IF (ierr .NE. NF_NOERR) THEN
656	PRINT*, "Variable ", tname(iq)," n est pas definie"
657	CALL abort
658	ENDIF
659	#ifdef NC_DOUBLE
660	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
661	#else
662	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
663	#endif
664
665	ELSE
666	PRINT*, tname(iq), "est present dans start_trac.nc"
667	#ifdef NC_DOUBLE
668	ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
669	#else
670	ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp)
671	#endif
672	IF (ierr .NE. NF_NOERR) THEN
673	PRINT*, "Lecture echouee pour", tname(iq)
674	CALL abort
675	ENDIF
676	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
677	IF (ierr .NE. NF_NOERR) THEN
678	PRINT*, "Variable ", tname(iq)," n est pas definie"
679	CALL abort
680	ENDIF
681	#ifdef NC_DOUBLE
682	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)
683	#else
684	ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)
685	#endif
686
687	ENDIF ! IF (ierr .NE. NF_NOERR)
688	! fin lecture du traceur
689	ELSE ! si il n'y a pas de fichier start_trac.nc
690	! print *, 'il n y a pas de fichier start_trac'
691	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
692	IF (ierr .NE. NF_NOERR) THEN
693	PRINT*, "Variable tname(iq) n est pas definie"
694	CALL abort
695	ENDIF
696	#ifdef NC_DOUBLE
697	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
698	#else
699	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
700	#endif
701	ENDIF ! (ierr_file .ne. 2)
702	END IF ! config_inca
703
704	ENDDO
705	ENDIF
706	c
707	ierr = NF_INQ_VARID(nid, "masse", nvarid)
708	IF (ierr .NE. NF_NOERR) THEN
709	PRINT*, "Variable masse n est pas definie"
710	CALL abort
711	ENDIF
712	#ifdef NC_DOUBLE
713	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
714	#else
715	ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
716	#endif
717	c
718	ierr = NF_INQ_VARID(nid, "ps", nvarid)
719	IF (ierr .NE. NF_NOERR) THEN
720	PRINT*, "Variable ps n est pas definie"
721	CALL abort
722	ENDIF
723	#ifdef NC_DOUBLE
724	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
725	#else
726	ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
727	#endif
728
729	ierr = NF_CLOSE(nid)
730	c
731	RETURN
732	END
733

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

Download in other formats:

Original Format