Context Navigation

dynredem.F @ 999

Last change on this file since 999 was 999, checked in by tnavarro, 11 years ago
Possibility to store multiple initial states in one start/startfi. This is RETROCOMPATIBLE. New option ecrithist in run.def to write data in start/startfi every ecrithist dynamical timestep. New option timestart in run.def to initialize the GCM with the time timestart stored in start
File size: 33.3 KB

Line
1	SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
2	IMPLICIT NONE
3	c=======================================================================
4	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
5	c=======================================================================
6	c Declarations:
7	c -------------
8	#include "dimensions.h"
9	#include "paramet.h"
10	#include "comconst.h"
11	#include "comvert.h"
12	#include "comgeom.h"
13	#include "temps.h"
14	#include "ener.h"
15	#include "logic.h"
16	#include "netcdf.inc"
17	#include "description.h"
18	#include "serre.h"
19	#include "advtrac.h"
20	c Arguments:
21	c ----------
22	INTEGER*4 idayref,anneeref
23	REAL phis(ip1jmp1)
24	CHARACTER() fichnom
25	INTEGER nq
26
27	c Local:
28	c ------
29	INTEGER iq,l
30	CHARACTER str3*3
31	INTEGER length
32	PARAMETER (length = 100)
33	REAL tab_cntrl(length) ! tableau des parametres du run
34	INTEGER ierr
35	character*20 modname
36	character*80 abort_message
37	character(len=80) :: txt ! to store some text
38
39	!REAL hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1
40
41
42	c Variables locales pour NetCDF:
43	c
44	INTEGER dims2(2), dims3(3), dims4(4)
45	INTEGER idim_index
46	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
47	INTEGER idim_llm, idim_llmp1
48	INTEGER idim_tim
49	INTEGER nid,nvarid
50
51	REAL zan0,zjulian,hours
52	REAL sigs(llm)
53	INTEGER yyears0,jjour0, mmois0
54	data yyears0 /1/
55	data jjour0 /1/
56	data mmois0 /1/
57	character*30 unites
58
59
60	c-----------------------------------------------------------------------
61	modname='dynredem'
62	do l=1,llm
63	sigs(l)=real(l)
64	enddo
65
66	DO l=1,length
67	tab_cntrl(l) = 0.
68	ENDDO
69	tab_cntrl(1) = REAL(iim)
70	tab_cntrl(2) = REAL(jjm)
71	tab_cntrl(3) = REAL(llm)
72	tab_cntrl(4) = REAL(idayref)
73	tab_cntrl(5) = rad
74	tab_cntrl(6) = omeg
75	tab_cntrl(7) = g
76	tab_cntrl(8) = cpp
77	tab_cntrl(9) = kappa
78	tab_cntrl(10) = daysec
79	tab_cntrl(11) = dtvr
80	tab_cntrl(12) = etot0
81	tab_cntrl(13) = ptot0
82	tab_cntrl(14) = ztot0
83	tab_cntrl(15) = stot0
84	tab_cntrl(16) = ang0
85	tab_cntrl(17) = pa
86	tab_cntrl(18) = preff
87
88	tab_cntrl(29) = hour_ini
89
90	c
91	c ..... parametres pour le zoom ......
92
93	tab_cntrl(19) = clon
94	tab_cntrl(20) = clat
95	tab_cntrl(21) = grossismx
96	tab_cntrl(22) = grossismy
97	c
98	IF ( fxyhypb ) THEN
99	tab_cntrl(23) = 1.
100	tab_cntrl(24) = dzoomx
101	tab_cntrl(25) = dzoomy
102	tab_cntrl(26) = 0.
103	tab_cntrl(27) = taux
104	tab_cntrl(28) = tauy
105	ELSE
106	tab_cntrl(23) = 0.
107	tab_cntrl(24) = dzoomx
108	tab_cntrl(25) = dzoomy
109	tab_cntrl(26) = 0.
110	tab_cntrl(27) = 0.
111	tab_cntrl(28) = 0.
112	IF( ysinus ) tab_cntrl(26) = 1.
113	ENDIF
114
115
116	c
117	c .........................................................
118	c
119	c Creation du fichier:
120	c
121	ierr = NF_CREATE(fichnom, IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
122	IF (ierr.NE.NF_NOERR) THEN
123	WRITE(6,*)" Failed creating file "//fichnom
124	WRITE(6,*)' ierr = ', ierr
125	CALL ABORT
126	ENDIF
127	c
128	c Preciser quelques attributs globaux:
129	c
130	ierr = NF_PUT_ATT_TEXT (nid,NF_GLOBAL,"title",18,
131	. "Dynamic start file")
132	if (ierr.ne.NF_NOERR) then
133	write(,) "dynredem0: Failed writing title in file "//fichnom
134	call abort
135	endif
136	c
137	c Definir les dimensions du fichiers:
138	c
139	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
140	if (ierr.ne.NF_NOERR) then
141	write(,) "dynredem0: Failed defining dimension <index> ",
142	& "in file "//fichnom
143	call abort
144	endif
145
146	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
147	if (ierr.ne.NF_NOERR) then
148	write(,) "dynredem0: Failed defining dimension <rlonu> ",
149	& "in file "//fichnom
150	call abort
151	endif
152
153	ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
154	if (ierr.ne.NF_NOERR) then
155	write(,) "dynredem0: Failed defining dimension <latitude> ",
156	& "in file "//fichnom
157	call abort
158	endif
159
160	ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
161	if (ierr.ne.NF_NOERR) then
162	write(,) "dynredem0: Failed defining dimension <longitude> ",
163	& "in file "//fichnom
164	call abort
165	endif
166
167	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
168	if (ierr.ne.NF_NOERR) then
169	write(,) "dynredem0: Failed defining dimension <rlatv> ",
170	& "in file "//fichnom
171	call abort
172	endif
173
174	ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
175	if (ierr.ne.NF_NOERR) then
176	write(,) "dynredem0: Failed defining dimension <altitude> ",
177	& "in file "//fichnom
178	call abort
179	endif
180
181	ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_llmp1)
182	if (ierr.ne.NF_NOERR) then
183	write(,) "dynredem0: Failed defining dimension <interlayer> ",
184	& "in file "//fichnom
185	call abort
186	endif
187
188	ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
189	if (ierr.ne.NF_NOERR) then
190	write(,) "dynredem0: Failed defining dimension <Time> ",
191	& "in file "//fichnom
192	call abort
193	endif
194
195
196	c CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
197	c ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
198	c ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
199	c ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
200	c
201	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
202	if (ierr.ne.NF_NOERR) then
203	write(,) "dynredem0: Failed to switch out of define mode",
204	& "in file "//fichnom
205	call abort
206	endif
207
208
209	c
210	c Definir et enregistrer certains champs invariants:
211	c
212	c ----------------------
213	c
214	ierr = NF_REDEF (nid)
215	if (ierr.ne.NF_NOERR) then
216	write(,) "dynredem0: Failed to switch back to define mode"
217	call abort
218	endif
219	#ifdef NC_DOUBLE
220	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
221	#else
222	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
223	#endif
224	if (ierr.ne.NF_NOERR) then
225	write(,) "dynredem0: Failed defining <controle> ",
226	& "in file "//fichnom
227	call abort
228	endif
229
230	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
231	. "Parametres de controle")
232	if (ierr.ne.NF_NOERR) then
233	write(,) "dynredem0: Failed writing title attribute ",
234	& "for <controle> in file "//fichnom
235	call abort
236	endif
237
238	ierr = NF_ENDDEF(nid)
239	if (ierr.ne.NF_NOERR) then
240	write(,) "dynredem0: Failed to switch out of define mode"
241	call abort
242	endif
243	#ifdef NC_DOUBLE
244	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
245	#else
246	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
247	#endif
248	if (ierr.ne.NF_NOERR) then
249	write(,) "dynredem0: Failed writing <controle> ",
250	& "in file "//fichnom
251	call abort
252	! else
253	! write(,) "dynredem0: controle(1)=",tab_cntrl(1)
254	endif
255
256	c
257	c ----------------------
258	c
259	ierr = NF_REDEF (nid)
260	if (ierr.ne.NF_NOERR) then
261	write(,) "dynredem0: Failed to switch back to define mode"
262	call abort
263	endif
264	#ifdef NC_DOUBLE
265	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
266	#else
267	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
268	#endif
269	if (ierr.ne.NF_NOERR) then
270	write(,) "dynredem0: Failed defining <rlonu> ",
271	& "in file "//fichnom
272	call abort
273	endif
274
275	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
276	. "Longitudes des points U")
277	if (ierr.ne.NF_NOERR) then
278	write(,) "dynredem0: Failed writing title attribute ",
279	& "for <rlonu> in file "//fichnom
280	call abort
281	endif
282
283	ierr = NF_ENDDEF(nid)
284	if (ierr.ne.NF_NOERR) then
285	write(,) "dynredem0: Failed to switch out of define mode"
286	call abort
287	endif
288	#ifdef NC_DOUBLE
289	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
290	#else
291	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
292	#endif
293	if (ierr.ne.NF_NOERR) then
294	write(,) "dynredem0: Failed writing <rlonu> ",
295	& "in file "//fichnom
296	call abort
297	endif
298
299	c
300	c ----------------------
301	c
302	ierr = NF_REDEF (nid)
303	if (ierr.ne.NF_NOERR) then
304	write(,) "dynredem0: Failed to switch back to define mode"
305	call abort
306	endif
307	#ifdef NC_DOUBLE
308	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
309	#else
310	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
311	#endif
312	if (ierr.ne.NF_NOERR) then
313	write(,) "dynredem0: Failed defining <rlatu> ",
314	& "in file "//fichnom
315	call abort
316	endif
317
318	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
319	. "Latitudes des points U")
320	if (ierr.ne.NF_NOERR) then
321	write(,) "dynredem0: Failed writing title attribute ",
322	& "for <rlatu> in file "//fichnom
323	call abort
324	endif
325
326	ierr = NF_ENDDEF(nid)
327	if (ierr.ne.NF_NOERR) then
328	write(,) "dynredem0: Failed to switch out of define mode"
329	call abort
330	endif
331	#ifdef NC_DOUBLE
332	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
333	#else
334	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
335	#endif
336	if (ierr.ne.NF_NOERR) then
337	write(,) "dynredem0: Failed writing <rlatu> ",
338	& "in file "//fichnom
339	call abort
340	endif
341
342	c
343	c ----------------------
344	c
345	ierr = NF_REDEF (nid)
346	if (ierr.ne.NF_NOERR) then
347	write(,) "dynredem0: Failed to switch back to define mode"
348	call abort
349	endif
350	#ifdef NC_DOUBLE
351	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
352	#else
353	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
354	#endif
355	if (ierr.ne.NF_NOERR) then
356	write(,) "dynredem0: Failed defining <rlonv> ",
357	& "in file "//fichnom
358	call abort
359	endif
360
361	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
362	. "Longitudes des points V")
363	if (ierr.ne.NF_NOERR) then
364	write(,) "dynredem0: Failed writing title attribute ",
365	& "for <rlonv> in file "//fichnom
366	call abort
367	endif
368
369	ierr = NF_ENDDEF(nid)
370	if (ierr.ne.NF_NOERR) then
371	write(,) "dynredem0: Failed to switch out of define mode"
372	call abort
373	endif
374	#ifdef NC_DOUBLE
375	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
376	#else
377	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
378	#endif
379	if (ierr.ne.NF_NOERR) then
380	write(,) "dynredem0: Failed writing <rlonv> ",
381	& "in file "//fichnom
382	call abort
383	endif
384
385	c
386	c ----------------------
387	c
388	ierr = NF_REDEF (nid)
389	if (ierr.ne.NF_NOERR) then
390	write(,) "dynredem0: Failed to switch back to define mode"
391	call abort
392	endif
393	#ifdef NC_DOUBLE
394	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
395	#else
396	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
397	#endif
398	if (ierr.ne.NF_NOERR) then
399	write(,) "dynredem0: Failed defining <rlatv> ",
400	& "in file "//fichnom
401	call abort
402	endif
403
404	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
405	. "Latitudes des points V")
406	if (ierr.ne.NF_NOERR) then
407	write(,) "dynredem0: Failed writing title attribute ",
408	& "for <rlatv> in file "//fichnom
409	call abort
410	endif
411
412	ierr = NF_ENDDEF(nid)
413	if (ierr.ne.NF_NOERR) then
414	write(,) "dynredem0: Failed to switch out of define mode"
415	call abort
416	endif
417	#ifdef NC_DOUBLE
418	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
419	#else
420	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
421	#endif
422	if (ierr.ne.NF_NOERR) then
423	write(,) "dynredem0: Failed writing <rlatv> ",
424	& "in file "//fichnom
425	call abort
426	endif
427	c
428	c ----------------------
429	c
430	ierr = NF_REDEF (nid)
431	if (ierr.ne.NF_NOERR) then
432	write(,) "dynredem0: Failed to switch back to define mode"
433	call abort
434	endif
435	#ifdef NC_DOUBLE
436	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
437	#else
438	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
439	#endif
440	if (ierr.ne.NF_NOERR) then
441	write(,) "dynredem0: Failed defining <ap> ",
442	& "in file "//fichnom
443	call abort
444	endif
445
446	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
447	. "Coef A: hybrid pressure levels" )
448	if (ierr.ne.NF_NOERR) then
449	write(,) "dynredem0: Failed writing title attribute ",
450	& "for <ap> in file "//fichnom
451	call abort
452	endif
453
454	ierr = NF_ENDDEF(nid)
455	if (ierr.ne.NF_NOERR) then
456	write(,) "dynredem0: Failed to switch out of define mode"
457	call abort
458	endif
459	#ifdef NC_DOUBLE
460	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
461	#else
462	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
463	#endif
464	if (ierr.ne.NF_NOERR) then
465	write(,) "dynredem0: Failed writing <ap> ",
466	& "in file "//fichnom
467	call abort
468	endif
469
470	c
471	c ----------------------
472	c
473	ierr = NF_REDEF (nid)
474	if (ierr.ne.NF_NOERR) then
475	write(,) "dynredem0: Failed to switch back to define mode"
476	call abort
477	endif
478	#ifdef NC_DOUBLE
479	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
480	#else
481	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
482	#endif
483	if (ierr.ne.NF_NOERR) then
484	write(,) "dynredem0: Failed defining <bp> ",
485	& "in file "//fichnom
486	call abort
487	endif
488
489	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
490	. "Coef B: hybrid sigma levels")
491	if (ierr.ne.NF_NOERR) then
492	write(,) "dynredem0: Failed writing title attribute ",
493	& "for <bp> in file "//fichnom
494	call abort
495	endif
496
497	ierr = NF_ENDDEF(nid)
498	if (ierr.ne.NF_NOERR) then
499	write(,) "dynredem0: Failed to switch out of define mode"
500	call abort
501	endif
502	#ifdef NC_DOUBLE
503	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
504	#else
505	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
506	#endif
507	if (ierr.ne.NF_NOERR) then
508	write(,) "dynredem0: Failed writing <bp> ",
509	& "in file "//fichnom
510	call abort
511	endif
512
513	c
514	c ----------------------
515	c
516	! ierr = NF_REDEF (nid)
517	! if (ierr.ne.NF_NOERR) then
518	! write(,) "dynredem0: Failed to switch back to define mode"
519	! call abort
520	! endif
521	!#ifdef NC_DOUBLE
522	! ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
523	!#else
524	! ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
525	!#endif
526	! if (ierr.ne.NF_NOERR) then
527	! write(,) "dynredem0: Failed defining <ap> ",
528	! & "in file "//fichnom
529	! call abort
530	! endif
531	!
532	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
533	! . "Coef A: hybrid pressure levels" )
534	! if (ierr.ne.NF_NOERR) then
535	! write(,) "dynredem0: Failed writing title attribute ",
536	! & "for <ap> in file "//fichnom
537	!
538	! ierr = NF_ENDDEF(nid)
539	! if (ierr.ne.NF_NOERR) then
540	! write(,) "dynredem0: Failed to switch out of define mode"
541	! call abort
542	! endif
543	!#ifdef NC_DOUBLE
544	! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
545	!#else
546	! ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
547	!#endif
548	! if (ierr.ne.NF_NOERR) then
549	! write(,) "dynredem0: Failed writing <bp> ",
550	! & "in file "//fichnom
551	! call abort
552	! endif
553	c
554	c ----------------------
555	c
556	c
557	ierr = NF_REDEF (nid)
558	if (ierr.ne.NF_NOERR) then
559	write(,) "dynredem0: Failed to switch back to define mode"
560	call abort
561	endif
562
563	#ifdef NC_DOUBLE
564	ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
565	#else
566	ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
567	#endif
568	if (ierr.ne.NF_NOERR) then
569	write(,) "dynredem0: Failed defining <aps> ",
570	& "in file "//fichnom
571	call abort
572	endif
573
574	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
575	. "Coef AS: hybrid pressure at midlayers")
576	if (ierr.ne.NF_NOERR) then
577	write(,) "dynredem0: Failed writing title attribute ",
578	& "for <aps> in file "//fichnom
579	call abort
580	endif
581
582	ierr = NF_ENDDEF(nid)
583	if (ierr.ne.NF_NOERR) then
584	write(,) "dynredem0: Failed to switch out of define mode"
585	call abort
586	endif
587
588	#ifdef NC_DOUBLE
589	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
590	#else
591	ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
592	#endif
593	if (ierr.ne.NF_NOERR) then
594	write(,) "dynredem0: Failed writing <aps> ",
595	& "in file "//fichnom
596	call abort
597	endif
598
599	c
600	c ----------------------
601	c
602	ierr = NF_REDEF (nid)
603	if (ierr.ne.NF_NOERR) then
604	write(,) "dynredem0: Failed to switch back to define mode"
605	call abort
606	endif
607
608	#ifdef NC_DOUBLE
609	ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
610	#else
611	ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
612	#endif
613	if (ierr.ne.NF_NOERR) then
614	write(,) "dynredem0: Failed defining <bps> ",
615	& "in file "//fichnom
616	call abort
617	endif
618
619	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
620	. "Coef BS: hybrid sigma at midlayers")
621	if (ierr.ne.NF_NOERR) then
622	write(,) "dynredem0: Failed writing title attribute ",
623	& "for <bps> in file "//fichnom
624	call abort
625	endif
626
627	ierr = NF_ENDDEF(nid)
628	if (ierr.ne.NF_NOERR) then
629	write(,) "dynredem0: Failed to switch out of define mode"
630	call abort
631	endif
632
633	#ifdef NC_DOUBLE
634	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
635	#else
636	ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
637	#endif
638	if (ierr.ne.NF_NOERR) then
639	write(,) "dynredem0: Failed writing <bps> ",
640	& "in file "//fichnom
641	call abort
642	endif
643
644	c
645	c ----------------------
646	c
647	ierr = NF_REDEF (nid)
648	if (ierr.ne.NF_NOERR) then
649	write(,) "dynredem0: Failed to switch back to define mode"
650	call abort
651	endif
652
653	#ifdef NC_DOUBLE
654	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
655	#else
656	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
657	#endif
658	if (ierr.ne.NF_NOERR) then
659	write(,) "dynredem0: Failed defining <presniv> ",
660	& "in file "//fichnom
661	call abort
662	endif
663
664	ierr = NF_ENDDEF(nid)
665	if (ierr.ne.NF_NOERR) then
666	write(,) "dynredem0: Failed to switch out of define mode"
667	call abort
668	endif
669
670	#ifdef NC_DOUBLE
671	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
672	#else
673	ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
674	#endif
675	if (ierr.ne.NF_NOERR) then
676	write(,) "dynredem0: Failed writing <presniv> ",
677	& "in file "//fichnom
678	call abort
679	endif
680
681	c ------------------------------------------------------------------
682	c ------------------------------------------------------------------
683	c Variable uniquement pour visualisation avec Grads ou Ferret
684	c ------------------------------------------------------------------
685	ierr = NF_REDEF (nid)
686	#ifdef NC_DOUBLE
687	ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
688	#else
689	ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
690	#endif
691	ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
692	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
693	. "North latitude")
694	ierr = NF_ENDDEF(nid)
695	#ifdef NC_DOUBLE
696	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
697	#else
698	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
699	#endif
700	c ----------------------
701	ierr = NF_REDEF (nid)
702	#ifdef NC_DOUBLE
703	ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
704	#else
705	ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
706	#endif
707	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
708	. "East longitude")
709	ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
710	ierr = NF_ENDDEF(nid)
711	#ifdef NC_DOUBLE
712	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
713	#else
714	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
715	#endif
716	c --------------------------
717	ierr = NF_REDEF (nid)
718	#ifdef NC_DOUBLE
719	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
720	. idim_llm,nvarid)
721	#else
722	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
723	. idim_llm,nvarid)
724	#endif
725	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
726	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
727	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
728
729	ierr = NF_ENDDEF(nid)
730	#ifdef NC_DOUBLE
731	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
732	#else
733	ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
734	#endif
735
736
737	c ----------------------
738	c ----------------------
739	c
740	c Coefficients de passage cov. <-> contra. <--> naturel
741	c
742	ierr = NF_REDEF (nid)
743	dims2(1) = idim_rlonu
744	dims2(2) = idim_rlatu
745	#ifdef NC_DOUBLE
746	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
747	#else
748	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
749	#endif
750	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
751	. "Coefficient de passage pour U")
752	ierr = NF_ENDDEF(nid)
753	#ifdef NC_DOUBLE
754	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
755	#else
756	ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
757	#endif
758	c
759	c ----------------------
760	ierr = NF_REDEF (nid)
761	dims2(1) = idim_rlonv
762	dims2(2) = idim_rlatv
763	#ifdef NC_DOUBLE
764	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
765	#else
766	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
767	#endif
768	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
769	. "Coefficient de passage pour V")
770	ierr = NF_ENDDEF(nid)
771	#ifdef NC_DOUBLE
772	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
773	#else
774	ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
775	#endif
776	c
777	c ----------------------
778	c Aire de chaque maille:
779	c
780	ierr = NF_REDEF (nid)
781	dims2(1) = idim_rlonv
782	dims2(2) = idim_rlatu
783	#ifdef NC_DOUBLE
784	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
785	#else
786	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
787	#endif
788	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
789	. "Aires de chaque maille")
790	ierr = NF_ENDDEF(nid)
791	#ifdef NC_DOUBLE
792	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
793	#else
794	ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
795	#endif
796	c
797	c ----------------------
798	c Geopentiel au sol:
799	c
800	ierr = NF_REDEF (nid)
801	dims2(1) = idim_rlonv
802	dims2(2) = idim_rlatu
803	#ifdef NC_DOUBLE
804	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
805	#else
806	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
807	#endif
808	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
809	. "Geopotentiel au sol")
810	ierr = NF_ENDDEF(nid)
811	#ifdef NC_DOUBLE
812	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
813	#else
814	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
815	#endif
816	c
817	c ----------------------
818	c Definir les variables pour pouvoir les enregistrer plus tard:
819	c
820	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
821	if (ierr.ne.NF_NOERR) then
822	write(,) "dynredem0: Failed to switch back to define mode"
823	call abort
824	endif
825
826	#ifdef NC_DOUBLE
827	ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
828	#else
829	ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
830	#endif
831	if (ierr.ne.NF_NOERR) then
832	write(,) "dynredem0: Failed defining <Time> ",
833	& "in file "//fichnom
834	call abort
835	endif
836
837	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
838	& "Temps de simulation")
839	if (ierr.ne.NF_NOERR) then
840	write(,) "dynredem0: Failed writing title attribute",
841	& "for <Time> in file "//fichnom
842	call abort
843	endif
844
845
846	write(unites,200)yyears0,mmois0,jjour0
847	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
848	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
849	. unites)
850	if (ierr.ne.NF_NOERR) then
851	write(,) "dynredem0: Failed writing units attribute",
852	& "for <Time> in file "//fichnom
853	call abort
854	endif
855
856
857	c
858	dims4(1) = idim_rlonu
859	dims4(2) = idim_rlatu
860	dims4(3) = idim_llm
861	dims4(4) = idim_tim
862	#ifdef NC_DOUBLE
863	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
864	#else
865	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
866	#endif
867	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
868	. "Vitesse U")
869	c
870	dims4(1) = idim_rlonv
871	dims4(2) = idim_rlatv
872	dims4(3) = idim_llm
873	dims4(4) = idim_tim
874	#ifdef NC_DOUBLE
875	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
876	#else
877	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
878	#endif
879	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
880	. "Vitesse V")
881	c
882	dims4(1) = idim_rlonv
883	dims4(2) = idim_rlatu
884	dims4(3) = idim_llm
885	dims4(4) = idim_tim
886	#ifdef NC_DOUBLE
887	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
888	#else
889	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
890	#endif
891	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
892	. "Temperature")
893	c
894	dims4(1) = idim_rlonv
895	dims4(2) = idim_rlatu
896	dims4(3) = idim_llm
897	dims4(4) = idim_tim
898	IF(nq.GE.1) THEN
899	DO iq=1,nq
900	IF (iq.GT.99) THEN
901	PRINT*, "Trop de traceurs"
902	CALL abort
903	ELSE
904	! str3(1:1)='q'
905	! WRITE(str3(2:3),'(i2.2)') iq
906	!#ifdef NC_DOUBLE
907	! ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
908	!#else
909	! ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
910	!#endif
911	! ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
912	! . "Traceurs "//str3)
913	txt="Traceur "//trim(tnom(iq))
914	#ifdef NC_DOUBLE
915	ierr=NF_DEF_VAR(nid,tnom(iq),NF_DOUBLE,4,dims4,nvarid)
916	#else
917	ierr=NF_DEF_VAR(nid,tnom(iq),NF_FLOAT,4,dims4,nvarid)
918	#endif
919	ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",
920	. len_trim(txt),trim(txt))
921	ENDIF
922	ENDDO
923	ENDIF
924	c
925	dims4(1) = idim_rlonv
926	dims4(2) = idim_rlatu
927	dims4(3) = idim_llm
928	dims4(4) = idim_tim
929	#ifdef NC_DOUBLE
930	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
931	#else
932	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
933	#endif
934	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
935	. "C est quoi ?")
936	c
937	dims3(1) = idim_rlonv
938	dims3(2) = idim_rlatu
939	dims3(3) = idim_tim
940	#ifdef NC_DOUBLE
941	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
942	#else
943	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
944	#endif
945	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
946	. "Pression au sol")
947	c
948	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
949	ierr = NF_CLOSE(nid) ! fermer le fichier
950
951	write(,)'dynredem0: iim,jjm,llm,idayref',iim,jjm,llm,idayref
952	write(,)'dynredem0: rad,omeg,g,cpp,kappa',
953	& rad,omeg,g,cpp,kappa
954
955	! stop "dynredem0 halt"
956
957	RETURN
958	END
959
960	c ================================================================
961	c ================================================================
962
963	SUBROUTINE dynredem1(fichnom,time,
964	. vcov,ucov,teta,q,nq,masse,ps)
965	IMPLICIT NONE
966	c=================================================================
967	c Ecriture du fichier de redemarrage sous format NetCDF
968	c=================================================================
969	#include "dimensions.h"
970	#include "paramet.h"
971	#include "description.h"
972	#include "netcdf.inc"
973	#include "comvert.h"
974	#include "comgeom.h"
975	#include"advtrac.h"
976
977	INTEGER nq, l
978	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
979	REAL teta(ip1jmp1,llm)
980	REAL ps(ip1jmp1),masse(ip1jmp1,llm)
981	REAL q(iip1,jjp1,llm,nqmx)
982	REAL q3d(iip1,jjp1,llm) !temporary variable
983	CHARACTER() fichnom
984
985	REAL time
986	INTEGER nid, nvarid
987	INTEGER ierr
988	INTEGER iq
989	CHARACTER str3*3
990	character*20 modname
991	character*80 abort_message
992	c
993
994	INTEGER edges(4),corner(4)
995
996	INTEGER nb,i,j
997
998
999	modname = 'dynredem1'
1000	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
1001	IF (ierr .NE. NF_NOERR) THEN
1002	PRINT*, "Pb. d ouverture "//fichnom
1003	CALL abort
1004	ENDIF
1005
1006	c On a single run, different files can be written with dynredem1.
1007	c Therefore, get the last time index from the file itself:
1008	ierr = NF_INQ_DIMID(nid,"Time",nvarid)
1009	ierr = NF_INQ_DIMLEN(nid,nvarid,nb)
1010
1011	c Ecriture/extension de la coordonnee temps
1012
1013	nb = nb + 1
1014	ierr = NF_INQ_VARID(nid, "Time", nvarid)
1015	IF (ierr .NE. NF_NOERR) THEN
1016	print *, NF_STRERROR(ierr)
1017	abort_message='Variable Time n est pas definie'
1018	CALL abort_gcm(modname,abort_message,ierr)
1019	ENDIF
1020	#ifdef NC_DOUBLE
1021	ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
1022	#else
1023	ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
1024	#endif
1025	IF (ierr .NE. NF_NOERR) THEN
1026	print*, "Erreur ecriture temps!!"
1027	print*, NF_STRERROR(ierr)
1028	ENDIF
1029	!PRINT*, "Enregistrement pour ", nb, time
1030
1031	c Ecriture des champs
1032	c
1033	corner(1)=1
1034	corner(2)=1
1035	corner(3)=1
1036	corner(4)=nb
1037	edges(1)=iip1
1038	edges(2)=jjm
1039	edges(3)=llm
1040	edges(4)=1
1041	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
1042	IF (ierr .NE. NF_NOERR) THEN
1043	PRINT*, "Variable vcov n est pas definie"
1044	CALL abort
1045	ENDIF
1046	#ifdef NC_DOUBLE
1047	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,vcov)
1048	#else
1049	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,vcov)
1050	#endif
1051	IF (ierr .NE. NF_NOERR) THEN
1052	print*, "Erreur ecriture vcov!!"
1053	print*, NF_STRERROR(ierr)
1054	ENDIF
1055
1056	c Following corner and egdes are the same for ucov, teta, tracers and masse:
1057	corner(1)=1
1058	corner(2)=1
1059	corner(3)=1
1060	corner(4)=nb
1061	edges(1)=iip1
1062	edges(2)=jjp1
1063	edges(3)=llm
1064	edges(4)=1
1065	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
1066	IF (ierr .NE. NF_NOERR) THEN
1067	PRINT*, "Variable ucov n est pas definie"
1068	CALL abort
1069	ENDIF
1070	#ifdef NC_DOUBLE
1071	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,ucov)
1072	#else
1073	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,ucov)
1074	#endif
1075	IF (ierr .NE. NF_NOERR) THEN
1076	print*, "Erreur ecriture ucov!!"
1077	print*, NF_STRERROR(ierr)
1078	ENDIF
1079
1080
1081	ierr = NF_INQ_VARID(nid, "teta", nvarid)
1082	IF (ierr .NE. NF_NOERR) THEN
1083	PRINT*, "Variable teta n est pas definie"
1084	CALL abort
1085	ENDIF
1086	#ifdef NC_DOUBLE
1087	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,teta)
1088	#else
1089	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,teta)
1090	#endif
1091	IF (ierr .NE. NF_NOERR) THEN
1092	print*, "Erreur ecriture teta!!"
1093	print*, NF_STRERROR(ierr)
1094	ENDIF
1095
1096	IF (nq.GT.99) THEN
1097	PRINT*, "Trop de traceurs"
1098	CALL abort
1099	ENDIF
1100	IF(nq.GE.1) THEN
1101	DO iq=1,nq
1102	! str3(1:1)='q'
1103	! WRITE(str3(2:3),'(i2.2)') iq
1104	! ierr = NF_INQ_VARID(nid, str3, nvarid)
1105	ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
1106	IF (ierr .NE. NF_NOERR) THEN
1107	! PRINT*, "Variable "//str3//" n est pas definie"
1108	PRINT*, "Variable "//trim(tnom(iq))//" n est pas definie"
1109	CALL abort
1110	ENDIF
1111	do l=1,llm
1112	do j=1,jjp1
1113	do i=1,iip1
1114	q3d(i,j,l)=q(i,j,l,iq)
1115	enddo
1116	enddo
1117	enddo
1118	#ifdef NC_DOUBLE
1119	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edgesq3d)
1120	#else
1121	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,q3d)
1122	#endif
1123	IF (ierr .NE. NF_NOERR) THEN
1124	PRINT*, "Error: ", NF_STRERROR(ierr)
1125	CALL abort
1126	ENDIF
1127	ENDDO
1128	ENDIF
1129	c
1130
1131	ierr = NF_INQ_VARID(nid, "masse", nvarid)
1132	IF (ierr .NE. NF_NOERR) THEN
1133	PRINT*, "Variable masse n est pas definie"
1134	CALL abort
1135	ENDIF
1136	#ifdef NC_DOUBLE
1137	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,masse)
1138	#else
1139	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,masse)
1140	#endif
1141	IF (ierr .NE. NF_NOERR) THEN
1142	print*, "Erreur ecriture masse!!"
1143	print*, NF_STRERROR(ierr)
1144	ENDIF
1145	c
1146
1147	corner(1)=1
1148	corner(2)=1
1149	corner(3)=nb
1150	edges(1)=iip1
1151	edges(2)=jjp1
1152	edges(3)=1
1153	ierr = NF_INQ_VARID(nid, "ps", nvarid)
1154	IF (ierr .NE. NF_NOERR) THEN
1155	PRINT*, "Variable ps n est pas definie"
1156	CALL abort
1157	ENDIF
1158	#ifdef NC_DOUBLE
1159	ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,ps)
1160	#else
1161	ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,ps)
1162	#endif
1163	IF (ierr .NE. NF_NOERR) THEN
1164	print*, "Erreur ecriture ps!!"
1165	print*, NF_STRERROR(ierr)
1166	ENDIF
1167
1168	ierr = NF_CLOSE(nid)
1169	c
1170	RETURN
1171	END
1172

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

Download in other formats:

Original Format