Context Navigation

dynredem.F @ 1000

Last change on this file since 1000 was 907, checked in by emillour, 12 years ago

Generic/common/universal models:

Added possibility to write restartfi.nc files in parallel (MPI)
Added arch files suitable for Ada (IDRIS supercomputer)
Some further cleanup is clearly required to merge generic/universal models
LMDZ.UNIVERSAL/libf/phygeneric/dimphy.F90 to be uptaded in following commit (can't both remove a symbolic link and create a file with the same name in a single commit with svn).

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

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

Download in other formats:

Original Format