Context Navigation

dynredem_p.F @ 1577

Last change on this file since 1577 was 1577, checked in by Laurent Fairhead, 13 years ago

Modifications au code qui permettent de commencer une simulation à n'importe
quelle heure de la journée. On fait toujours un nombre entier de jours de
simulation.
On spécifie cette heure de départ dans la variable starttime du run.def (la
valeur est en jour et elle est à zéro par défaut).
La valeur est sauvegardée dans le fichier restart.nc. Les valeurs lues dans
le fichier start et le run.def sont comparées en début de simulation. La
simulation s'arrête si elles ne sont pas égales sauf si une remise à zéro de
la date a été demandée.
Par ailleurs, la fréquence de lecture des conditions aux limites a été modifiée
pour qu'à chaque changement de jour, celles-ci soient mises à jour (jusqu'à
maintenant elles étaient mises à jour à une fréquence donnée qui, en cas de
départ de simulation à une heure différente de minuit, ne correspondait pas
forcèment à un changement dans la date).
Validation effectuée en traçant le flux solaire descendant au sommet de
l'atmosphère à différentes heures de la journée, après un redémarrage, en
s'assurant que le maximum est bien là où il est sensé être.

Modifications to the code to enable it to be started at any time of the day.
The code still runs for an integer number of days.
The start time is specified using variable starttime in the run.def file (the
value is in days and is zero by default).
The start time is saved in the restart.nc file at the end of the simulation.
The values read in from the start.nc file and the run.def file are compared
at the start of the simulation. If they differ, the simulation is aborted
unless the raz_date variable has been set.
Furthermore, the frequency at which boundary conditions are read in has been
modified so that they are updated everyday at midnight (until now, they were
updated at a certain frequency that, in case of a simulation starting at a time
other than midnight, did not ensure that those conditions would be updated each
day at midnight)
The modifications were validated by plotting the downward solaf flux at TOA at
different times of the day (and after having restarted the simulation) and
ensuring that the maximum of flux was at the right place according to local
time.

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 1577 2011-10-20 15:06:47Z 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