Context Navigation

dynredem.F @ 1558

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

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

Download in other formats:

Original Format