Context Navigation

dynredem.F @ 1422

Last change on this file since 1422 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: 25.7 KB

Line
1	!
2	! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $
3	!
4	c
5	SUBROUTINE dynredem0(fichnom,iday_end,phis)
6	#ifdef CPP_IOIPSL
7	USE IOIPSL
8	#endif
9	USE infotrac
10	use netcdf95, only: NF95_PUT_VAR
11	use control_mod, only : planet_type
12	USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff,
13	. nivsig,nivsigs
14	USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
15	USE logic_mod, ONLY: fxyhypb,ysinus
16	USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy,
17	. taux,tauy
18	USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin,
19	. start_time,hour_ini
20	USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
21
22	IMPLICIT NONE
23	c=======================================================================
24	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
25	c=======================================================================
26	c Declarations:
27	c -------------
28	#include "dimensions.h"
29	#include "paramet.h"
30	#include "comgeom2.h"
31	#include "netcdf.inc"
32	#include "iniprint.h"
33
34	c Arguments:
35	c ----------
36	INTEGER iday_end
37	REAL phis(iip1, jjp1)
38	CHARACTER() fichnom
39
40	c Local:
41	c ------
42	INTEGER iq,l
43	INTEGER length
44	PARAMETER (length = 100)
45	REAL tab_cntrl(length) ! tableau des parametres du run
46	INTEGER ierr
47	character*20 modname
48	character*80 abort_message
49
50	c Variables locales pour NetCDF:
51	c
52	INTEGER dims2(2), dims3(3), dims4(4)
53	INTEGER idim_index
54	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
55	INTEGER idim_s, idim_sig
56	INTEGER idim_tim
57	INTEGER nid,nvarid
58
59	REAL zan0,zjulian,hours
60	INTEGER yyears0,jjour0, mmois0
61	character*30 unites
62
63	character(len=12) :: start_file_type="earth" ! default start file type
64	INTEGER idecal
65
66	c-----------------------------------------------------------------------
67	modname='dynredem0'
68
69	#ifdef CPP_IOIPSL
70	call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
71	call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
72	#else
73	! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
74	yyears0=0
75	mmois0=1
76	jjour0=1
77	#endif
78
79	!!! AS: idecal is a hack to be able to read planeto starts...
80	!!! .... while keeping everything OK for LMDZ EARTH
81	if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
82	write(lunout,*) trim(modname),' : Planeto-like start file'
83	start_file_type="planeto"
84	idecal = 4
85	else
86	write(lunout,*) trim(modname),' : Earth-like start file'
87	idecal = 5
88	endif
89
90	DO l=1,length
91	tab_cntrl(l) = 0.
92	ENDDO
93	tab_cntrl(1) = REAL(iim)
94	tab_cntrl(2) = REAL(jjm)
95	tab_cntrl(3) = REAL(llm)
96	if (start_file_type.eq."earth") then
97	tab_cntrl(4)=REAL(day_ref)
98	else
99	!tab_cntrl(4)=REAL(day_end)
100	tab_cntrl(4)=REAL(iday_end)
101	endif
102	tab_cntrl(5) = REAL(annee_ref)
103	tab_cntrl(idecal+1) = rad
104	tab_cntrl(idecal+2) = omeg
105	tab_cntrl(idecal+3) = g
106	tab_cntrl(idecal+4) = cpp
107	tab_cntrl(idecal+5) = kappa
108	tab_cntrl(idecal+6) = daysec
109	tab_cntrl(idecal+7) = dtvr
110	tab_cntrl(idecal+8) = etot0
111	tab_cntrl(idecal+9) = ptot0
112	tab_cntrl(idecal+10) = ztot0
113	tab_cntrl(idecal+11) = stot0
114	tab_cntrl(idecal+12) = ang0
115	tab_cntrl(idecal+13) = pa
116	tab_cntrl(idecal+14) = preff
117	c
118	c ..... parametres pour le zoom ......
119
120	tab_cntrl(idecal+15) = clon
121	tab_cntrl(idecal+16) = clat
122	tab_cntrl(idecal+17) = grossismx
123	tab_cntrl(idecal+18) = grossismy
124	c
125	IF ( fxyhypb ) THEN
126	tab_cntrl(idecal+19) = 1.
127	tab_cntrl(idecal+20) = dzoomx
128	tab_cntrl(idecal+21) = dzoomy
129	tab_cntrl(idecal+22) = 0.
130	tab_cntrl(idecal+23) = taux
131	tab_cntrl(idecal+24) = tauy
132	ELSE
133	tab_cntrl(idecal+19) = 0.
134	tab_cntrl(idecal+20) = dzoomx
135	tab_cntrl(idecal+21) = dzoomy
136	tab_cntrl(idecal+22) = 0.
137	tab_cntrl(idecal+23) = 0.
138	tab_cntrl(idecal+24) = 0.
139	IF( ysinus ) tab_cntrl(idecal+22) = 1.
140	ENDIF
141
142	if (start_file_type.eq."earth") then
143	tab_cntrl(idecal+25) = REAL(iday_end)
144	tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
145	c start_time: start_time of simulation (not necessarily 0.)
146	tab_cntrl(idecal+27) = start_time
147	endif
148
149	if (planet_type=="mars") then ! For Mars only
150	tab_cntrl(29)=hour_ini
151	endif
152	c
153	c .........................................................
154	c
155	c Creation du fichier:
156	c
157	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
158	IF (ierr.NE.NF_NOERR) THEN
159	write(lunout,*)"dynredem0: Pb d ouverture du fichier "
160	& //trim(fichnom)
161	write(lunout,*)' ierr = ', ierr
162	CALL ABORT_GCM("DYNREDEM0", "", 1)
163	ENDIF
164	c
165	c Preciser quelques attributs globaux:
166	c
167	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
168	. "Fichier demmarage dynamique")
169	c
170	c Definir les dimensions du fichiers:
171	c
172	if (start_file_type.eq."earth") then
173	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
174	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
175	ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
176	ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
177	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
178	ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
179	ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
180	ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
181	else
182	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
183	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
184	ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
185	ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
186	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
187	ierr = NF_DEF_DIM (nid, "altitude", llm, idim_s)
188	ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_sig)
189	ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
190	endif
191	c
192	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
193	c
194	c Definir et enregistrer certains champs invariants:
195	c
196	ierr = NF_REDEF (nid)
197	cIM 220306 BEG
198	#ifdef NC_DOUBLE
199	ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
200	#else
201	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
202	#endif
203	cIM 220306 END
204	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
205	. "Parametres de controle")
206	ierr = NF_ENDDEF(nid)
207	call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
208	c
209	ierr = NF_REDEF (nid)
210	cIM 220306 BEG
211	#ifdef NC_DOUBLE
212	ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
213	#else
214	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
215	#endif
216	cIM 220306 END
217	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
218	. "Longitudes des points U")
219	ierr = NF_ENDDEF(nid)
220	call NF95_PUT_VAR(nid,nvarid,rlonu)
221	c
222	ierr = NF_REDEF (nid)
223	cIM 220306 BEG
224	#ifdef NC_DOUBLE
225	ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
226	#else
227	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
228	#endif
229	cIM 220306 END
230	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
231	. "Latitudes des points U")
232	ierr = NF_ENDDEF(nid)
233	call NF95_PUT_VAR (nid,nvarid,rlatu)
234	c
235	ierr = NF_REDEF (nid)
236	cIM 220306 BEG
237	#ifdef NC_DOUBLE
238	ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
239	#else
240	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
241	#endif
242	cIM 220306 END
243	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
244	. "Longitudes des points V")
245	ierr = NF_ENDDEF(nid)
246	call NF95_PUT_VAR(nid,nvarid,rlonv)
247	c
248	ierr = NF_REDEF (nid)
249	cIM 220306 BEG
250	#ifdef NC_DOUBLE
251	ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
252	#else
253	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
254	#endif
255	cIM 220306 END
256	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
257	. "Latitudes des points V")
258	ierr = NF_ENDDEF(nid)
259	call NF95_PUT_VAR(nid,nvarid,rlatv)
260	c
261	if (start_file_type.eq."earth") then
262	ierr = NF_REDEF (nid)
263	cIM 220306 BEG
264	#ifdef NC_DOUBLE
265	ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
266	#else
267	ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
268	#endif
269	cIM 220306 END
270	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
271	. "Numero naturel des couches s")
272	ierr = NF_ENDDEF(nid)
273	call NF95_PUT_VAR(nid,nvarid,nivsigs)
274	c
275	ierr = NF_REDEF (nid)
276	cIM 220306 BEG
277	#ifdef NC_DOUBLE
278	ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
279	#else
280	ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
281	#endif
282	cIM 220306 END
283	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
284	. "Numero naturel des couches sigma")
285	ierr = NF_ENDDEF(nid)
286	call NF95_PUT_VAR(nid,nvarid,nivsig)
287	endif ! of if (start_file_type.eq."earth")
288	c
289	ierr = NF_REDEF (nid)
290	cIM 220306 BEG
291	#ifdef NC_DOUBLE
292	ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
293	#else
294	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
295	#endif
296	cIM 220306 END
297	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
298	. "Coefficient A pour hybride")
299	ierr = NF_ENDDEF(nid)
300	call NF95_PUT_VAR(nid,nvarid,ap)
301	c
302	ierr = NF_REDEF (nid)
303	cIM 220306 BEG
304	#ifdef NC_DOUBLE
305	ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
306	#else
307	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
308	#endif
309	cIM 220306 END
310	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
311	. "Coefficient B pour hybride")
312	ierr = NF_ENDDEF(nid)
313	call NF95_PUT_VAR(nid,nvarid,bp)
314	c
315	if (start_file_type.ne."earth") then
316	ierr = NF_REDEF (nid)
317	cIM 220306 BEG
318	#ifdef NC_DOUBLE
319	ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_s,nvarid)
320	#else
321	ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_s,nvarid)
322	#endif
323	cIM 220306 END
324	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
325	. "Coef AS: hybrid pressure at midlayers")
326	ierr = NF_ENDDEF(nid)
327	call NF95_PUT_VAR(nid,nvarid,aps)
328	c
329	ierr = NF_REDEF (nid)
330	cIM 220306 BEG
331	#ifdef NC_DOUBLE
332	ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_s,nvarid)
333	#else
334	ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_s,nvarid)
335	#endif
336	cIM 220306 END
337	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
338	. "Coef BS: hybrid sigma at midlayers")
339	ierr = NF_ENDDEF(nid)
340	call NF95_PUT_VAR(nid,nvarid,bps)
341	endif ! of if (start_file_type.ne."earth")
342	c
343	ierr = NF_REDEF (nid)
344	cIM 220306 BEG
345	#ifdef NC_DOUBLE
346	ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
347	#else
348	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
349	#endif
350	cIM 220306 END
351	ierr = NF_ENDDEF(nid)
352	call NF95_PUT_VAR(nid,nvarid,presnivs)
353	c
354	if (start_file_type.ne."earth") then
355	ierr = NF_REDEF (nid)
356	#ifdef NC_DOUBLE
357	ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
358	#else
359	ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
360	#endif
361	ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
362	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
363	. "North latitude")
364	ierr = NF_ENDDEF(nid)
365	call NF95_PUT_VAR(nid,nvarid,rlatu*180/pi)
366	c
367	ierr = NF_REDEF (nid)
368	#ifdef NC_DOUBLE
369	ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,nvarid)
370	#else
371	ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,nvarid)
372	#endif
373	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
374	. "East longitude")
375	ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
376	ierr = NF_ENDDEF(nid)
377	call NF95_PUT_VAR(nid,nvarid,rlonv*180/pi)
378	c
379	ierr = NF_REDEF (nid)
380	#ifdef NC_DOUBLE
381	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
382	. idim_s,nvarid)
383	#else
384	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
385	. idim_s,nvarid)
386	#endif
387	ierr = NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
388	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
389	ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
390	ierr = NF_ENDDEF(nid)
391	call NF95_PUT_VAR(nid,nvarid,pseudoalt)
392	endif ! of if (start_file_type.ne."earth")
393	c
394	c Coefficients de passage cov. <-> contra. <--> naturel
395	c
396	ierr = NF_REDEF (nid)
397	dims2(1) = idim_rlonu
398	dims2(2) = idim_rlatu
399	cIM 220306 BEG
400	#ifdef NC_DOUBLE
401	ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
402	#else
403	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
404	#endif
405	cIM 220306 END
406	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
407	. "Coefficient de passage pour U")
408	ierr = NF_ENDDEF(nid)
409	call NF95_PUT_VAR(nid,nvarid,cu)
410	c
411	ierr = NF_REDEF (nid)
412	dims2(1) = idim_rlonv
413	dims2(2) = idim_rlatv
414	cIM 220306 BEG
415	#ifdef NC_DOUBLE
416	ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
417	#else
418	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
419	#endif
420	cIM 220306 END
421	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
422	. "Coefficient de passage pour V")
423	ierr = NF_ENDDEF(nid)
424	call NF95_PUT_VAR(nid,nvarid,cv)
425	c
426	c Aire de chaque maille:
427	c
428	ierr = NF_REDEF (nid)
429	dims2(1) = idim_rlonv
430	dims2(2) = idim_rlatu
431	cIM 220306 BEG
432	#ifdef NC_DOUBLE
433	ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
434	#else
435	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
436	#endif
437	cIM 220306 END
438	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
439	. "Aires de chaque maille")
440	ierr = NF_ENDDEF(nid)
441	call NF95_PUT_VAR(nid,nvarid,aire)
442	c
443	c Geopentiel au sol:
444	c
445	ierr = NF_REDEF (nid)
446	dims2(1) = idim_rlonv
447	dims2(2) = idim_rlatu
448	cIM 220306 BEG
449	#ifdef NC_DOUBLE
450	ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
451	#else
452	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
453	#endif
454	cIM 220306 END
455	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
456	. "Geopotentiel au sol")
457	ierr = NF_ENDDEF(nid)
458	call NF95_PUT_VAR(nid,nvarid,phis)
459	c
460	c Definir les variables pour pouvoir les enregistrer plus tard:
461	c
462	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
463	c
464	if (start_file_type.eq."earth") then
465	cIM 220306 BEG
466	#ifdef NC_DOUBLE
467	ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
468	#else
469	ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
470	#endif
471	cIM 220306 END
472	else ! start_file_type=="planeto"
473	#ifdef NC_DOUBLE
474	ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
475	#else
476	ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
477	#endif
478	endif ! of if (start_file_type.eq."earth")
479	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
480	. "Temps de simulation")
481	write(unites,200)yyears0,mmois0,jjour0
482	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
483	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
484	. unites)
485
486	c
487	dims4(1) = idim_rlonu
488	dims4(2) = idim_rlatu
489	dims4(3) = idim_s
490	dims4(4) = idim_tim
491	cIM 220306 BEG
492	#ifdef NC_DOUBLE
493	ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
494	#else
495	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
496	#endif
497	cIM 220306 END
498	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
499	. "Vitesse U")
500	c
501	dims4(1) = idim_rlonv
502	dims4(2) = idim_rlatv
503	dims4(3) = idim_s
504	dims4(4) = idim_tim
505	cIM 220306 BEG
506	#ifdef NC_DOUBLE
507	ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
508	#else
509	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
510	#endif
511	cIM 220306 END
512	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
513	. "Vitesse V")
514	c
515	dims4(1) = idim_rlonv
516	dims4(2) = idim_rlatu
517	dims4(3) = idim_s
518	dims4(4) = idim_tim
519	cIM 220306 BEG
520	#ifdef NC_DOUBLE
521	ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
522	#else
523	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
524	#endif
525	cIM 220306 END
526	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
527	. "Temperature")
528	c
529	dims4(1) = idim_rlonv
530	dims4(2) = idim_rlatu
531	dims4(3) = idim_s
532	dims4(4) = idim_tim
533	IF(nqtot.GE.1) THEN
534	DO iq=1,nqtot
535	cIM 220306 BEG
536	#ifdef NC_DOUBLE
537	ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
538	#else
539	ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
540	#endif
541	cIM 220306 END
542	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
543	ENDDO
544	ENDIF
545	c
546	dims4(1) = idim_rlonv
547	dims4(2) = idim_rlatu
548	dims4(3) = idim_s
549	dims4(4) = idim_tim
550	cIM 220306 BEG
551	#ifdef NC_DOUBLE
552	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
553	#else
554	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
555	#endif
556	cIM 220306 END
557	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
558	. "C est quoi ?")
559	c
560	dims3(1) = idim_rlonv
561	dims3(2) = idim_rlatu
562	dims3(3) = idim_tim
563	cIM 220306 BEG
564	#ifdef NC_DOUBLE
565	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
566	#else
567	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
568	#endif
569	cIM 220306 END
570	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
571	. "Pression au sol")
572	c
573	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
574	ierr = NF_CLOSE(nid) ! fermer le fichier
575
576	write(lunout,*)'dynredem0: iim,jjm,llm,iday_end',
577	& iim,jjm,llm,iday_end
578	write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa',
579	& rad,omeg,g,cpp,kappa
580
581	RETURN
582	END
583
584	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
585
586	SUBROUTINE dynredem1(fichnom,time,
587	. vcov,ucov,teta,q,masse,ps)
588	USE infotrac
589	USE control_mod, only : planet_type
590	use netcdf, only: NF90_get_VAR
591	use netcdf95, only: NF95_PUT_VAR
592	USE temps_mod, ONLY: itaufin,itau_dyn
593
594	IMPLICIT NONE
595	c=================================================================
596	c Ecriture du fichier de redemarrage sous format NetCDF
597	c=================================================================
598	#include "dimensions.h"
599	#include "paramet.h"
600	#include "netcdf.inc"
601	#include "comgeom.h"
602	#include "iniprint.h"
603
604
605	INTEGER l
606	REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm)
607	REAL teta(iip1, jjp1,llm)
608	REAL ps(iip1, jjp1),masse(iip1, jjp1,llm)
609	REAL q(iip1, jjp1, llm, nqtot)
610	CHARACTER() fichnom
611
612	REAL time
613	INTEGER nid, nvarid, nid_trac, nvarid_trac
614	REAL trac_tmp(ip1jmp1,llm)
615	INTEGER ierr, ierr_file
616	INTEGER iq
617	INTEGER length
618	PARAMETER (length = 100)
619	REAL tab_cntrl(length) ! tableau des parametres du run
620	character(len=*),parameter :: modname='dynredem1'
621	character*80 abort_message
622	c
623	INTEGER nb
624	SAVE nb
625	DATA nb / 0 /
626	character(len=12) :: start_file_type="earth" ! default start file type
627
628	if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
629	write(lunout,*) trim(modname),' : Planeto-like start file'
630	start_file_type="planeto"
631	else
632	write(lunout,*) trim(modname),' : Earth-like start file'
633	endif
634
635	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
636	IF (ierr .NE. NF_NOERR) THEN
637	PRINT*, "dynredem1: Pb. d ouverture "//trim(fichnom)
638	CALL abort_gcm("dynredem1", "", 1)
639	ENDIF
640
641	c Ecriture/extension de la coordonnee temps
642
643	nb = nb + 1
644	if (start_file_type.eq."earth") then
645	ierr = NF_INQ_VARID(nid, "temps", nvarid)
646	IF (ierr .NE. NF_NOERR) THEN
647	write(lunout,*) NF_STRERROR(ierr)
648	abort_message='Variable temps n est pas definie'
649	CALL abort_gcm(modname,abort_message,ierr)
650	ENDIF
651	else
652	ierr = NF_INQ_VARID(nid,"Time", nvarid)
653	IF (ierr .NE. NF_NOERR) THEN
654	write(lunout,*) NF_STRERROR(ierr)
655	abort_message='Variable Time not found'
656	CALL abort_gcm(modname,abort_message,ierr)
657	ENDIF
658	endif ! of if (start_file_type.eq."earth")
659	call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/))
660	write(lunout,*) "dynredem1: Enregistrement pour ", nb, time
661
662	c
663	c Re-ecriture du tableau de controle, itaufin n'est plus defini quand
664	c on passe dans dynredem0
665	ierr = NF_INQ_VARID (nid, "controle", nvarid)
666	IF (ierr .NE. NF_NOERR) THEN
667	abort_message="dynredem1: Le champ <controle> est absent"
668	ierr = 1
669	CALL abort_gcm(modname,abort_message,ierr)
670	ENDIF
671	ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)
672	if (start_file_type=="earth") then
673	tab_cntrl(31) = REAL(itau_dyn + itaufin)
674	else
675	tab_cntrl(31) = 0
676	endif
677	call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
678
679	c Ecriture des champs
680	c
681	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
682	IF (ierr .NE. NF_NOERR) THEN
683	abort_message="Variable ucov n est pas definie"
684	ierr=1
685	CALL abort_gcm(modname,abort_message,ierr)
686	ENDIF
687	call NF95_PUT_VAR(nid,nvarid,ucov,start=(/1,1,1,nb/))
688
689	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
690	IF (ierr .NE. NF_NOERR) THEN
691	abort_message="Variable vcov n est pas definie"
692	ierr=1
693	CALL abort_gcm(modname,abort_message,ierr)
694	ENDIF
695	call NF95_PUT_VAR(nid,nvarid,vcov,start=(/1,1,1,nb/))
696
697	ierr = NF_INQ_VARID(nid, "teta", nvarid)
698	IF (ierr .NE. NF_NOERR) THEN
699	abort_message="Variable teta n est pas definie"
700	ierr=1
701	CALL abort_gcm(modname,abort_message,ierr)
702	ENDIF
703	call NF95_PUT_VAR(nid,nvarid,teta,start=(/1,1,1,nb/))
704
705	IF (type_trac == 'inca') THEN
706	! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
707	ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
708	IF (ierr_file .NE.NF_NOERR) THEN
709	write(lunout,*)'dynredem1: Pb d''ouverture du fichier',
710	& ' start_trac.nc'
711	write(lunout,*)' ierr = ', ierr_file
712	ENDIF
713	END IF
714
715	IF(nqtot.GE.1) THEN
716	do iq=1,nqtot
717
718	IF (type_trac /= 'inca') THEN
719	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
720	IF (ierr .NE. NF_NOERR) THEN
721	abort_message="Variable tname(iq) n est pas definie"
722	ierr=1
723	CALL abort_gcm(modname,abort_message,ierr)
724	ENDIF
725	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),start=(/1,1,1,nb/))
726	ELSE ! type_trac = inca
727	! lecture de la valeur du traceur dans start_trac.nc
728	IF (ierr_file .ne. 2) THEN
729	ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
730	IF (ierr .NE. NF_NOERR) THEN
731	write(lunout,*) "dynredem1: ",trim(tname(iq)),
732	& " est absent de start_trac.nc"
733	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
734	IF (ierr .NE. NF_NOERR) THEN
735	abort_message="dynredem1: Variable "//
736	& trim(tname(iq))//" n est pas definie"
737	ierr=1
738	CALL abort_gcm(modname,abort_message,ierr)
739	ENDIF
740	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
741
742	ELSE
743	write(lunout,*) "dynredem1: ",trim(tname(iq)),
744	& " est present dans start_trac.nc"
745	ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp)
746	IF (ierr .NE. NF_NOERR) THEN
747	abort_message="dynredem1: Lecture echouee pour"//
748	& trim(tname(iq))
749	ierr=1
750	CALL abort_gcm(modname,abort_message,ierr)
751	ENDIF
752	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
753	IF (ierr .NE. NF_NOERR) THEN
754	abort_message="dynredem1: Variable "//
755	& trim(tname(iq))//" n est pas definie"
756	ierr=1
757	CALL abort_gcm(modname,abort_message,ierr)
758	ENDIF
759	call NF95_PUT_VAR(nid, nvarid, trac_tmp)
760
761	ENDIF ! IF (ierr .NE. NF_NOERR)
762	! fin lecture du traceur
763	ELSE ! si il n'y a pas de fichier start_trac.nc
764	! print *, 'il n y a pas de fichier start_trac'
765	ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
766	IF (ierr .NE. NF_NOERR) THEN
767	abort_message="dynredem1: Variable "//
768	& trim(tname(iq))//" n est pas definie"
769	ierr=1
770	CALL abort_gcm(modname,abort_message,ierr)
771	ENDIF
772	call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),
773	& start=(/1,1,1,nb/))
774	ENDIF ! (ierr_file .ne. 2)
775	END IF !type_trac
776
777	ENDDO
778	ENDIF
779	c
780	ierr = NF_INQ_VARID(nid, "masse", nvarid)
781	IF (ierr .NE. NF_NOERR) THEN
782	abort_message="dynredem1: Variable masse n est pas definie"
783	ierr=1
784	CALL abort_gcm(modname,abort_message,ierr)
785	ENDIF
786	call NF95_PUT_VAR(nid,nvarid,masse,start=(/1,1,1,nb/))
787	c
788	ierr = NF_INQ_VARID(nid, "ps", nvarid)
789	IF (ierr .NE. NF_NOERR) THEN
790	abort_message="dynredem1: Variable ps n est pas definie"
791	ierr=1
792	CALL abort_gcm(modname,abort_message,ierr)
793	ENDIF
794	call NF95_PUT_VAR(nid,nvarid,ps,start=(/1,1,nb/))
795
796	ierr = NF_CLOSE(nid)
797	c
798	RETURN
799	END
800

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

Download in other formats:

Original Format