Context Navigation

dynredem.F @ 1563

Last change on this file since 1563 was 1563, checked in by jghattas, 13 years ago

Added reading of paramter type_trac from *.def file : type_trac=lmdz(default), inca or repr(soon). While running with INCA, 2 parameters are now necessare in .def : type_trac=inca and config_inca=aero/chem. If type_trac=lmdz or repr, config_inca will not be used.

Removed print of ecrit_mth, ecrit_day etc in physiq.F. Removed the variable ecrit_hf2mth which is no longer used.

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

File size: 22.0 KB

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

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

Download in other formats:

Original Format