Context Navigation

dynredem.F @ 2150

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

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

Download in other formats:

Original Format