Context Navigation

dynredem_p.F @ 1453

Last change on this file since 1453 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.2 KB

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

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

Download in other formats:

Original Format