Context Navigation

dynredem.F @ 1632

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

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 20.9 KB

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

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

Download in other formats:

Original Format