Context Navigation

dynredem_p.F @ 5214

Last change on this file since 5214 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 21.5 KB

Line
1	!
2	! $Id: dynredem_p.F 1299 2010-01-20 14:27:21Z dcugnet $
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