Context Navigation

dynredem.F @ 1299

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

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

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

Download in other formats:

Original Format