Context Navigation

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

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

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

Download in other formats:

Original Format