Context Navigation

dynredem.F @ 182

Last change on this file since 182 was 179, checked in by lmdzadmin, 23 years ago

Synchronisation avec version MAFO:

ajout sortie netcdf des champs echanges avec le coupleur
quelques save sur les variables (pb stack/static sur le nec)

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 14.9 KB

Line
1	c $Header$
2	c
3	SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
4	USE IOIPSL
5	IMPLICIT NONE
6	c=======================================================================
7	c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
8	c=======================================================================
9	c Declarations:
10	c -------------
11	#include "dimensions.h"
12	#include "paramet.h"
13	#include "comconst.h"
14	#include "comvert.h"
15	#include "comgeom.h"
16	#include "temps.h"
17	#include "ener.h"
18	#include "logic.h"
19	#include "netcdf.inc"
20	#include "description.h"
21	#include "serre.h"
22
23	c Arguments:
24	c ----------
25	INTEGER*4 idayref,anneeref
26	REAL phis(ip1jmp1)
27	CHARACTER() fichnom
28	INTEGER nq
29
30	c Local:
31	c ------
32	INTEGER iq,l
33	CHARACTER str3*3
34	INTEGER length
35	PARAMETER (length = 100)
36	REAL tab_cntrl(length) ! tableau des parametres du run
37	INTEGER ierr
38	character*20 modname
39	character*80 abort_message
40
41	c Variables locales pour NetCDF:
42	c
43	INTEGER dims2(2), dims3(3), dims4(4)
44	INTEGER idim_index
45	INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
46	INTEGER idim_s, idim_sig
47	INTEGER idim_tim
48	INTEGER nid,nvarid
49
50	REAL zan0,zjulian,hours
51	INTEGER yyears0,jjour0, mmois0
52	character*30 unites
53
54
55	c-----------------------------------------------------------------------
56	modname='dynredem'
57
58	call ymds2ju(anneeref,1,idayref,0.0, zjulian)
59	call ju2ymds(zjulian, yyears0,mmois0,jjour0,hours)
60
61
62	DO l=1,length
63	tab_cntrl(l) = 0.
64	ENDDO
65	tab_cntrl(1) = FLOAT(iim)
66	tab_cntrl(2) = FLOAT(jjm)
67	tab_cntrl(3) = FLOAT(llm)
68	tab_cntrl(4) = FLOAT(idayref)
69	tab_cntrl(5) = FLOAT(anneeref)
70	tab_cntrl(6) = rad
71	tab_cntrl(7) = omeg
72	tab_cntrl(8) = g
73	tab_cntrl(9) = cpp
74	tab_cntrl(10) = kappa
75	tab_cntrl(11) = daysec
76	tab_cntrl(12) = dtvr
77	tab_cntrl(13) = etot0
78	tab_cntrl(14) = ptot0
79	tab_cntrl(15) = ztot0
80	tab_cntrl(16) = stot0
81	tab_cntrl(17) = ang0
82	tab_cntrl(18) = pa
83	tab_cntrl(19) = preff
84	c
85	c ..... parametres pour le zoom ......
86
87	tab_cntrl(20) = clon
88	tab_cntrl(21) = clat
89	tab_cntrl(22) = grossismx
90	tab_cntrl(23) = grossismy
91	c
92	IF ( fxyhypb ) THEN
93	tab_cntrl(24) = 1.
94	tab_cntrl(25) = dzoomx
95	tab_cntrl(26) = dzoomy
96	ELSE
97	tab_cntrl(24) = 0.
98	tab_cntrl(25) = dzoomx
99	tab_cntrl(26) = dzoomy
100	tab_cntrl(27) = 0.
101	IF( ysinus ) tab_cntrl(27) = 1.
102	ENDIF
103	c
104	c .........................................................
105	c
106	c Creation du fichier:
107	c
108	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
109	IF (ierr.NE.NF_NOERR) THEN
110	WRITE(6,*)" Pb d ouverture du fichier "//fichnom
111	WRITE(6,*)' ierr = ', ierr
112	CALL ABORT
113	ENDIF
114	c
115	c Preciser quelques attributs globaux:
116	c
117	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
118	. "Fichier demmarage dynamique")
119	c
120	c Definir les dimensions du fichiers:
121	c
122	ierr = NF_DEF_DIM (nid, "index", length, idim_index)
123	ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
124	ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
125	ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
126	ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
127	ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
128	ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
129	ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
130	c
131	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
132	c
133	c Definir et enregistrer certains champs invariants:
134	c
135	ierr = NF_REDEF (nid)
136	ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
137	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
138	. "Parametres de controle")
139	ierr = NF_ENDDEF(nid)
140	#ifdef NC_DOUBLE
141	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
142	#else
143	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
144	#endif
145	c
146	ierr = NF_REDEF (nid)
147	ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
148	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
149	. "Longitudes des points U")
150	ierr = NF_ENDDEF(nid)
151	#ifdef NC_DOUBLE
152	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
153	#else
154	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
155	#endif
156	c
157	ierr = NF_REDEF (nid)
158	ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
159	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
160	. "Latitudes des points U")
161	ierr = NF_ENDDEF(nid)
162	#ifdef NC_DOUBLE
163	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
164	#else
165	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
166	#endif
167	c
168	ierr = NF_REDEF (nid)
169	ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
170	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
171	. "Longitudes des points V")
172	ierr = NF_ENDDEF(nid)
173	#ifdef NC_DOUBLE
174	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
175	#else
176	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
177	#endif
178	c
179	ierr = NF_REDEF (nid)
180	ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
181	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
182	. "Latitudes des points V")
183	ierr = NF_ENDDEF(nid)
184	#ifdef NC_DOUBLE
185	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
186	#else
187	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
188	#endif
189	c
190	ierr = NF_REDEF (nid)
191	ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
192	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
193	. "Numero naturel des couches s")
194	ierr = NF_ENDDEF(nid)
195	#ifdef NC_DOUBLE
196	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
197	#else
198	ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
199	#endif
200	c
201	ierr = NF_REDEF (nid)
202	ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
203	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
204	. "Numero naturel des couches sigma")
205	ierr = NF_ENDDEF(nid)
206	#ifdef NC_DOUBLE
207	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
208	#else
209	ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
210	#endif
211	c
212	ierr = NF_REDEF (nid)
213	ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
214	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
215	. "Coefficient A pour hybride")
216	ierr = NF_ENDDEF(nid)
217	#ifdef NC_DOUBLE
218	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
219	#else
220	ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
221	#endif
222	c
223	ierr = NF_REDEF (nid)
224	ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
225	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
226	. "Coefficient B pour hybride")
227	ierr = NF_ENDDEF(nid)
228	#ifdef NC_DOUBLE
229	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
230	#else
231	ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
232	#endif
233	c
234	ierr = NF_REDEF (nid)
235	ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
236	ierr = NF_ENDDEF(nid)
237	#ifdef NC_DOUBLE
238	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
239	#else
240	ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
241	#endif
242	c
243	c Coefficients de passage cov. <-> contra. <--> naturel
244	c
245	ierr = NF_REDEF (nid)
246	dims2(1) = idim_rlonu
247	dims2(2) = idim_rlatu
248	ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
249	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
250	. "Coefficient de passage pour U")
251	ierr = NF_ENDDEF(nid)
252	#ifdef NC_DOUBLE
253	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
254	#else
255	ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
256	#endif
257	c
258	ierr = NF_REDEF (nid)
259	dims2(1) = idim_rlonv
260	dims2(2) = idim_rlatv
261	ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
262	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
263	. "Coefficient de passage pour V")
264	ierr = NF_ENDDEF(nid)
265	#ifdef NC_DOUBLE
266	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
267	#else
268	ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
269	#endif
270	c
271	c Aire de chaque maille:
272	c
273	ierr = NF_REDEF (nid)
274	dims2(1) = idim_rlonv
275	dims2(2) = idim_rlatu
276	ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
277	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
278	. "Aires de chaque maille")
279	ierr = NF_ENDDEF(nid)
280	#ifdef NC_DOUBLE
281	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
282	#else
283	ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
284	#endif
285	c
286	c Geopentiel au sol:
287	c
288	ierr = NF_REDEF (nid)
289	dims2(1) = idim_rlonv
290	dims2(2) = idim_rlatu
291	ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
292	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
293	. "Geopotentiel au sol")
294	ierr = NF_ENDDEF(nid)
295	#ifdef NC_DOUBLE
296	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
297	#else
298	ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
299	#endif
300	c
301	c Definir les variables pour pouvoir les enregistrer plus tard:
302	c
303	ierr = NF_REDEF (nid) ! entrer dans le mode de definition
304	c
305	ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
306	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
307	. "Temps de simulation")
308	write(unites,200)yyears0,mmois0,jjour0
309	200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
310	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
311	. unites)
312
313	c
314	dims4(1) = idim_rlonu
315	dims4(2) = idim_rlatu
316	dims4(3) = idim_s
317	dims4(4) = idim_tim
318	ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
319	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
320	. "Vitesse U")
321	c
322	dims4(1) = idim_rlonv
323	dims4(2) = idim_rlatv
324	dims4(3) = idim_s
325	dims4(4) = idim_tim
326	ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
327	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
328	. "Vitesse V")
329	c
330	dims4(1) = idim_rlonv
331	dims4(2) = idim_rlatu
332	dims4(3) = idim_s
333	dims4(4) = idim_tim
334	ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
335	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
336	. "Temperature")
337	c
338	dims4(1) = idim_rlonv
339	dims4(2) = idim_rlatu
340	dims4(3) = idim_s
341	dims4(4) = idim_tim
342	IF(nq.GE.1) THEN
343	DO iq=1,nq
344	IF (iq.GT.99) THEN
345	PRINT*, "Trop de traceurs"
346	CALL abort
347	ELSE
348	str3(1:1)='q'
349	WRITE(str3(2:3),'(i2.2)') iq
350	ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
351	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
352	. "Traceurs "//str3)
353	ENDIF
354	ENDDO
355	ENDIF
356	c
357	dims4(1) = idim_rlonv
358	dims4(2) = idim_rlatu
359	dims4(3) = idim_s
360	dims4(4) = idim_tim
361	ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
362	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
363	. "C est quoi ?")
364	c
365	dims3(1) = idim_rlonv
366	dims3(2) = idim_rlatu
367	dims3(3) = idim_tim
368	ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
369	ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
370	. "Pression au sol")
371	c
372	ierr = NF_ENDDEF(nid) ! sortir du mode de definition
373	ierr = NF_CLOSE(nid) ! fermer le fichier
374
375	PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
376	PRINT*,'rad,omeg,g,cpp,kappa',
377	, rad,omeg,g,cpp,kappa
378
379	RETURN
380	END
381	SUBROUTINE dynredem1(fichnom,time,
382	. vcov,ucov,teta,q,nq,masse,ps)
383	IMPLICIT NONE
384	c=================================================================
385	c Ecriture du fichier de redemarrage sous format NetCDF
386	c=================================================================
387	#include "dimensions.h"
388	#include "paramet.h"
389	#include "description.h"
390	#include "netcdf.inc"
391	#include "comvert.h"
392	#include "comgeom.h"
393
394	INTEGER nq, l
395	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
396	REAL teta(ip1jmp1,llm)
397	REAL ps(ip1jmp1),masse(ip1jmp1,llm)
398	REAL q(ip1jmp1,llm,nq)
399	CHARACTER() fichnom
400
401	REAL time
402	INTEGER nid, nvarid
403	INTEGER ierr
404	INTEGER iq
405	CHARACTER str3*3
406	character*20 modname
407	character*80 abort_message
408	c
409	INTEGER nb
410	SAVE nb
411	DATA nb / 0 /
412
413	modname = 'dynredem1'
414	ierr = NF_OPEN(fichnom, NF_WRITE, nid)
415	IF (ierr .NE. NF_NOERR) THEN
416	PRINT*, "Pb. d ouverture "//fichnom
417	CALL abort
418	ENDIF
419
420	c Ecriture/extension de la coordonnee temps
421
422	nb = nb + 1
423	ierr = NF_INQ_VARID(nid, "temps", nvarid)
424	IF (ierr .NE. NF_NOERR) THEN
425	print *, NF_STRERROR(ierr)
426	abort_message='Variable temps n est pas definie'
427	CALL abort_gcm(modname,abort_message,ierr)
428	ENDIF
429	#ifdef NC_DOUBLE
430	ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
431	#else
432	ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
433	#endif
434	PRINT*, "Enregistrement pour ", nb, time
435
436	c Ecriture des champs
437	c
438	ierr = NF_INQ_VARID(nid, "ucov", nvarid)
439	IF (ierr .NE. NF_NOERR) THEN
440	PRINT*, "Variable ucov n est pas definie"
441	CALL abort
442	ENDIF
443	#ifdef NC_DOUBLE
444	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
445	#else
446	ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
447	#endif
448
449	ierr = NF_INQ_VARID(nid, "vcov", nvarid)
450	IF (ierr .NE. NF_NOERR) THEN
451	PRINT*, "Variable vcov n est pas definie"
452	CALL abort
453	ENDIF
454	#ifdef NC_DOUBLE
455	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
456	#else
457	ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
458	#endif
459
460	ierr = NF_INQ_VARID(nid, "teta", nvarid)
461	IF (ierr .NE. NF_NOERR) THEN
462	PRINT*, "Variable teta n est pas definie"
463	CALL abort
464	ENDIF
465	#ifdef NC_DOUBLE
466	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
467	#else
468	ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
469	#endif
470
471	IF(nq.GE.1) THEN
472	DO iq=1,nq
473	IF (iq.GT.99) THEN
474	PRINT*, "Trop de traceurs"
475	CALL abort
476	ELSE
477	str3(1:1)='q'
478	WRITE(str3(2:3),'(i2.2)') iq
479	ierr = NF_INQ_VARID(nid, str3, nvarid)
480	IF (ierr .NE. NF_NOERR) THEN
481	PRINT*, "Variable "//str3//" n est pas definie"
482	CALL abort
483	ENDIF
484	#ifdef NC_DOUBLE
485	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
486	#else
487	ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
488	#endif
489	ENDIF
490	ENDDO
491	ENDIF
492	c
493	ierr = NF_INQ_VARID(nid, "masse", nvarid)
494	IF (ierr .NE. NF_NOERR) THEN
495	PRINT*, "Variable masse n est pas definie"
496	CALL abort
497	ENDIF
498	#ifdef NC_DOUBLE
499	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
500	#else
501	ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
502	#endif
503	c
504	ierr = NF_INQ_VARID(nid, "ps", nvarid)
505	IF (ierr .NE. NF_NOERR) THEN
506	PRINT*, "Variable ps n est pas definie"
507	CALL abort
508	ENDIF
509	#ifdef NC_DOUBLE
510	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
511	#else
512	ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
513	#endif
514
515	ierr = NF_CLOSE(nid)
516	c
517	RETURN
518	END
519

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

Download in other formats:

Original Format