Context Navigation

dynredem.F @ 2236

Last change on this file since 2236 was 1422, checked in by milmd, 10 years ago
In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).
File size: 31.8 KB

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

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

Download in other formats:

Original Format