Context Navigation

dynredem.F @ 1106

Last change on this file since 1106 was 1106, checked in by tnavarro, 11 years ago
option freedust with ice microphysics & masse naming in start files
File size: 33.4 KB

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

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

Download in other formats:

Original Format