Context Navigation

dynredem.F @ 1665

Last change on this file since 1665 was 1665, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1628

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

File size: 22.1 KB

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

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

Download in other formats:

Original Format