Context Navigation

dynredem_p.F @ 1198

Last change on this file since 1198 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: 21.4 KB

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

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

Download in other formats:

Original Format