Context Navigation

dynredem_p.F @ 1068

Last change on this file since 1068 was 985, checked in by Laurent Fairhead, 16 years ago
Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 21.2 KB

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

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

Download in other formats:

Original Format