Context Navigation

dynredem.F @ 588

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

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

Download in other formats:

Original Format