Context Navigation

dynredem_p.F @ 1243

Last change on this file since 1243 was 1107, checked in by emillour, 11 years ago

Common dynamics: Updates and modifications to enable running Mars physics with

LMDZ.COMMON dynamics:

For compilation: adapted makelmdz, create_make_gcm and makelmdz_fcm, bld.cfg to compile aeronomy routines in "aerono$physique" if it exists, and added "-P -traditional" preprocessing flags in "arch-linux-ifort*"
Added function "cbrt.F" (cubic root) in 'bibio'
Adapted the reading/writing of dynamics (re)start.nc files for Mars. The main issue is that different information (on time, reference and current) is stored and used differently, hence a few if (planet_type =="mars") here and there. Moreover in the martian case there is the possibility to store fields over multiple times. Some Mars-specific variables (ecritphy,ecritstart,timestart) added in control_mod.F and (hour_ini) in temps.h

File size: 24.9 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
14	IMPLICIT NONE
15	c=======================================================================
16	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
17	c=======================================================================
18	c Declarations:
19	c -------------
20	#include "dimensions.h"
21	#include "paramet.h"
22	#include "comconst.h"
23	#include "comvert.h"
24	#include "comgeom2.h"
25	#include "temps.h"
26	#include "ener.h"
27	#include "logic.h"
28	#include "netcdf.inc"
29	#include "description.h"
30	#include "serre.h"
31	#include "iniprint.h"
32
33	c Arguments:
34	c ----------
35	INTEGER iday_end
36	REAL phis(iip1, jjp1)
37	CHARACTER() fichnom
38
39	c Local:
40	c ------
41	INTEGER iq,l
42	INTEGER length
43	PARAMETER (length = 100)
44	REAL tab_cntrl(length) ! tableau des parametres du run
45	INTEGER ierr
46	character*20 modname
47	character*80 abort_message
48
49	c Variables locales pour NetCDF:
50	c
51	INTEGER dims2(2), dims3(3), dims4(4)
52	INTEGER idim_index
53	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
54	INTEGER idim_s, idim_sig
55	INTEGER idim_tim
56	INTEGER nid,nvarid
57
58	REAL zan0,zjulian,hours
59	INTEGER yyears0,jjour0, mmois0
60	character*30 unites
61
62	character(len=12) :: start_file_type="earth" ! default start file type
63	INTEGER idecal
64
65	c-----------------------------------------------------------------------
66	if (mpi_rank==0) then
67
68	modname='dynredem0_p'
69
70	#ifdef CPP_IOIPSL
71	call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
72	call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
73	#else
74	! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
75	yyears0=0
76	mmois0=1
77	jjour0=1
78	#endif
79
80	!!! AS: idecal is a hack to be able to read planeto starts...
81	!!! .... while keeping everything OK for LMDZ EARTH
82	if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
83	write(lunout,*) trim(modname),' : Planeto-like start file'
84	start_file_type="planeto"
85	idecal = 4
86	else
87	write(lunout,*) trim(modname),' : Earth-like start file'
88	idecal = 5
89	endif
90
91	DO l=1,length
92	tab_cntrl(l) = 0.
93	ENDDO
94	tab_cntrl(1) = REAL(iim)
95	tab_cntrl(2) = REAL(jjm)
96	tab_cntrl(3) = REAL(llm)
97	if (start_file_type.eq."earth") then
98	tab_cntrl(4)=REAL(day_ref)
99	else
100	!tab_cntrl(4)=REAL(day_end)
101	tab_cntrl(4)=REAL(iday_end)
102	endif
103	tab_cntrl(5) = REAL(annee_ref)
104	tab_cntrl(idecal+1) = rad
105	tab_cntrl(idecal+2) = omeg
106	tab_cntrl(idecal+3) = g
107	tab_cntrl(idecal+4) = cpp
108	tab_cntrl(idecal+5) = kappa
109	tab_cntrl(idecal+6) = daysec
110	tab_cntrl(idecal+7) = dtvr
111	tab_cntrl(idecal+8) = etot0
112	tab_cntrl(idecal+9) = ptot0
113	tab_cntrl(idecal+10) = ztot0
114	tab_cntrl(idecal+11) = stot0
115	tab_cntrl(idecal+12) = ang0
116	tab_cntrl(idecal+13) = pa
117	tab_cntrl(idecal+14) = preff
118	c
119	c ..... parametres pour le zoom ......
120
121	tab_cntrl(idecal+15) = clon
122	tab_cntrl(idecal+16) = clat
123	tab_cntrl(idecal+17) = grossismx
124	tab_cntrl(idecal+18) = grossismy
125	c
126	IF ( fxyhypb ) THEN
127	tab_cntrl(idecal+19) = 1.
128	tab_cntrl(idecal+20) = dzoomx
129	tab_cntrl(idecal+21) = dzoomy
130	tab_cntrl(idecal+22) = 0.
131	tab_cntrl(idecal+23) = taux
132	tab_cntrl(idecal+24) = tauy
133	ELSE
134	tab_cntrl(idecal+19) = 0.
135	tab_cntrl(idecal+20) = dzoomx
136	tab_cntrl(idecal+21) = dzoomy
137	tab_cntrl(idecal+22) = 0.
138	tab_cntrl(idecal+23) = 0.
139	tab_cntrl(idecal+24) = 0.
140	IF( ysinus ) tab_cntrl(idecal+22) = 1.
141	ENDIF
142
143	if (start_file_type.eq."earth") then
144	tab_cntrl(idecal+25) = REAL(iday_end)
145	tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
146	c start_time: start_time of simulation (not necessarily 0.)
147	tab_cntrl(idecal+27) = start_time
148	endif
149
150	if (planet_type=="mars") then ! For Mars only
151	tab_cntrl(29)=hour_ini
152	endif
153	c
154	c .........................................................
155	c
156	c Creation du fichier:
157	c
158	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
159	IF (ierr.NE.NF_NOERR) THEN
160	WRITE(6,*)" Pb d ouverture du fichier "//fichnom
161	WRITE(6,*)' ierr = ', ierr
162	CALL ABORT
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
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	c
545	dims4(1) = idim_rlonv
546	dims4(2) = idim_rlatu
547	dims4(3) = idim_s
548	dims4(4) = idim_tim
549	cIM 220306 BEG
550	#ifdef NC_DOUBLE
551	ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
552	#else
553	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
554	#endif
555	cIM 220306 END
556	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
557	. "C est quoi ?")
558	c
559	dims3(1) = idim_rlonv
560	dims3(2) = idim_rlatu
561	dims3(3) = idim_tim
562	cIM 220306 BEG
563	#ifdef NC_DOUBLE
564	ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
565	#else
566	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
567	#endif
568	cIM 220306 END
569	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
570	. "Pression au sol")
571	c
572	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
573	ierr = NF_CLOSE(nid) ! fermer le fichier
574
575	PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
576	PRINT*,'rad,omeg,g,cpp,kappa',
577	, rad,omeg,g,cpp,kappa
578
579	endif ! mpi_rank==0
580	RETURN
581	END
582
583	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
584
585	SUBROUTINE dynredem1_p(fichnom,time,
586	. vcov,ucov,teta,q,masse,ps)
587	USE parallel_lmdz
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
593	IMPLICIT NONE
594	c=================================================================
595	c Ecriture du fichier de redemarrage sous format NetCDF
596	c=================================================================
597	#include "dimensions.h"
598	#include "paramet.h"
599	#include "description.h"
600	#include "netcdf.inc"
601	#include "comvert.h"
602	#include "comgeom.h"
603	#include "temps.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