Context Navigation

dynredem_p.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: 21.6 KB

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

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

Download in other formats:

Original Format