Context Navigation

physdem.F @ 301

Last change on this file since 301 was 232, checked in by lmdzadmin, 23 years ago
Merge par rapport a la branche principale LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 18.2 KB

Line
1	SUBROUTINE physdem (fichnom,dtime,radpas,co2_ppm,solaire,
2	. rlat,rlon, pctsrf,tsol,tsoil,deltat,qsol,snow,
3	. albedo, evap, rain_fall, snow_fall,
4	. solsw, sollw,
5	. radsol,frugs,agesno,
6	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
7	. t_ancien, q_ancien)
8	IMPLICIT none
9	c======================================================================
10	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
11	c Objet: Ecriture de l'etat de redemarrage pour la physique
12	c======================================================================
13	#include "dimensions.h"
14	#include "dimphy.h"
15	#include "netcdf.inc"
16	#include "indicesol.h"
17	#include "dimsoil.h"
18	#include "clesph0.h"
19	#include "control.h"
20	#include "temps.h"
21	c======================================================================
22	CHARACTER() fichnom
23	REAL dtime
24	INTEGER radpas
25	REAL rlat(klon), rlon(klon)
26	REAL co2_ppm
27	REAL solaire
28	REAL tsol(klon,nbsrf)
29	REAL tsoil(klon,nsoilmx,nbsrf)
30	REAL deltat(klon)
31	REAL qsol(klon,nbsrf)
32	REAL snow(klon,nbsrf)
33	REAL albedo(klon,nbsrf)
34	REAL evap(klon,nbsrf)
35	REAL rain_fall(klon)
36	REAL snow_fall(klon)
37	real solsw(klon)
38	real sollw(klon)
39	REAL radsol(klon)
40	REAL frugs(klon,nbsrf)
41	REAL agesno(klon)
42	REAL zmea(klon)
43	REAL zstd(klon)
44	REAL zsig(klon)
45	REAL zgam(klon)
46	REAL zthe(klon)
47	REAL zpic(klon)
48	REAL zval(klon)
49	REAL rugsrel(klon)
50	REAL pctsrf(klon, nbsrf)
51	REAL t_ancien(klon,klev), q_ancien(klon,klev)
52	c
53	INTEGER nid, nvarid, idim1, idim2, idim3
54	INTEGER ierr
55	INTEGER length
56	PARAMETER (length=100)
57	REAL tab_cntrl(length)
58	c
59	INTEGER isoil, nsrf
60	CHARACTER*7 str7
61	CHARACTER*2 str2
62	c
63	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
64	IF (ierr.NE.NF_NOERR) THEN
65	write(6,*)' Pb d''ouverture du fichier '//fichnom
66	write(6,*)' ierr = ', ierr
67	CALL ABORT
68	ENDIF
69	c
70	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
71	. "Fichier redemmarage physique")
72	c
73	ierr = NF_DEF_DIM (nid, "index", length, idim1)
74	ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
75	ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
76	c
77	ierr = NF_ENDDEF(nid)
78	c
79	DO ierr = 1, length
80	tab_cntrl(ierr) = 0.0
81	ENDDO
82	tab_cntrl(1) = dtime
83	tab_cntrl(2) = radpas
84	tab_cntrl(3) = co2_ppm
85	tab_cntrl(4) = solaire
86	tab_cntrl(5) = iflag_con
87	tab_cntrl(6) = nbapp_rad
88
89	IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
90	IF( soil_model ) tab_cntrl( 8 ) = 1.
91	IF( new_oliq ) tab_cntrl( 9 ) = 1.
92	IF( ok_orodr ) tab_cntrl(10 ) = 1.
93	IF( ok_orolf ) tab_cntrl(11 ) = 1.
94
95	tab_cntrl(13) = dayref
96	tab_cntrl(14) = anneeref
97	tab_cntrl(13) = day_end
98	tab_cntrl(14) = anne_ini
99	c
100	ierr = NF_REDEF (nid)
101	#ifdef NC_DOUBLE
102	ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
103	#else
104	ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
105	#endif
106	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
107	. "Parametres de controle")
108	ierr = NF_ENDDEF(nid)
109	#ifdef NC_DOUBLE
110	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
111	#else
112	ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
113	#endif
114	c
115	ierr = NF_REDEF (nid)
116	#ifdef NC_DOUBLE
117	ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
118	#else
119	ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
120	#endif
121	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
122	. "Longitudes de la grille physique")
123	ierr = NF_ENDDEF(nid)
124	#ifdef NC_DOUBLE
125	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
126	#else
127	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
128	#endif
129	c
130	ierr = NF_REDEF (nid)
131	#ifdef NC_DOUBLE
132	ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
133	#else
134	ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
135	#endif
136	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
137	. "Latitudes de la grille physique")
138	ierr = NF_ENDDEF(nid)
139	#ifdef NC_DOUBLE
140	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
141	#else
142	ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
143	#endif
144	c
145	C PB ajout du masque terre/mer
146	C
147	ierr = NF_REDEF (nid)
148	#ifdef NC_DOUBLE
149	ierr = NF_DEF_VAR (nid, "masque", NF_DOUBLE, 1, idim2,nvarid)
150	#else
151	ierr = NF_DEF_VAR (nid, "masque", NF_FLOAT, 1, idim2,nvarid)
152	#endif
153	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 16,
154	. "masque terre mer")
155	ierr = NF_ENDDEF(nid)
156	#ifdef NC_DOUBLE
157	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmasq)
158	#else
159	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmasq)
160	#endif
161	c BP ajout des fraction de chaque sous-surface
162	C
163	C 1. fraction de terre
164	C
165	ierr = NF_REDEF (nid)
166	#ifdef NC_DOUBLE
167	ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 1, idim2,nvarid)
168	#else
169	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 1, idim2,nvarid)
170	#endif
171	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
172	. "fraction de continent")
173	ierr = NF_ENDDEF(nid)
174	#ifdef NC_DOUBLE
175	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_ter))
176	#else
177	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_ter))
178	#endif
179	C
180	C 2. Fraction de glace de terre
181	C
182	ierr = NF_REDEF (nid)
183	#ifdef NC_DOUBLE
184	ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 1, idim2,nvarid)
185	#else
186	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 1, idim2,nvarid)
187	#endif
188	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
189	. "fraction glace de terre")
190	ierr = NF_ENDDEF(nid)
191	#ifdef NC_DOUBLE
192	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon,is_lic))
193	#else
194	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_lic))
195	#endif
196	C
197	C 3. fraction ocean
198	C
199	ierr = NF_REDEF (nid)
200	#ifdef NC_DOUBLE
201	ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 1, idim2,nvarid)
202	#else
203	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 1, idim2,nvarid)
204	#endif
205	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
206	. "fraction ocean")
207	ierr = NF_ENDDEF(nid)
208	#ifdef NC_DOUBLE
209	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_oce))
210	#else
211	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_oce))
212	#endif
213	C
214	C 4. Fraction glace de mer
215	C
216	ierr = NF_REDEF (nid)
217	#ifdef NC_DOUBLE
218	ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 1, idim2,nvarid)
219	#else
220	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 1, idim2,nvarid)
221	#endif
222	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
223	. "fraction glace mer")
224	ierr = NF_ENDDEF(nid)
225	#ifdef NC_DOUBLE
226	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf(1 : klon, is_sic))
227	#else
228	ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf(1 : klon, is_sic))
229	#endif
230	C
231	C
232	c
233	DO nsrf = 1, nbsrf
234	IF (nsrf.LE.99) THEN
235	WRITE(str2,'(i2.2)') nsrf
236	ierr = NF_REDEF (nid)
237	#ifdef NC_DOUBLE
238	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
239	#else
240	ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
241	#endif
242	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
243	. "Temperature de surface No."//str2)
244	ierr = NF_ENDDEF(nid)
245	ELSE
246	PRINT*, "Trop de sous-mailles"
247	CALL abort
248	ENDIF
249	#ifdef NC_DOUBLE
250	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf))
251	#else
252	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf))
253	#endif
254	ENDDO
255	c
256	DO nsrf = 1, nbsrf
257	DO isoil=1, nsoilmx
258	IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
259	WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
260	ierr = NF_REDEF (nid)
261	#ifdef NC_DOUBLE
262	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
263	#else
264	ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
265	#endif
266	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
267	. "Temperature du sol No."//str7)
268	ierr = NF_ENDDEF(nid)
269	ELSE
270	PRINT*, "Trop de couches"
271	CALL abort
272	ENDIF
273	#ifdef NC_DOUBLE
274	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
275	#else
276	ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
277	#endif
278	ENDDO
279	ENDDO
280	c
281	c
282	ierr = NF_REDEF (nid)
283	#ifdef NC_DOUBLE
284	ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
285	#else
286	ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
287	#endif
288	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
289	. "Ecart de la SST (pour slab-ocean)")
290	ierr = NF_ENDDEF(nid)
291	#ifdef NC_DOUBLE
292	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
293	#else
294	ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
295	#endif
296	c
297	DO nsrf = 1, nbsrf
298	IF (nsrf.LE.99) THEN
299	WRITE(str2,'(i2.2)') nsrf
300	ierr = NF_REDEF (nid)
301	#ifdef NC_DOUBLE
302	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
303	#else
304	ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
305	#endif
306	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
307	. "Humidite de surface No."//str2)
308	ierr = NF_ENDDEF(nid)
309	ELSE
310	PRINT*, "Trop de sous-mailles"
311	CALL abort
312	ENDIF
313	#ifdef NC_DOUBLE
314	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol(1,nsrf))
315	#else
316	ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol(1,nsrf))
317	#endif
318	ENDDO
319	c
320	DO nsrf = 1, nbsrf
321	IF (nsrf.LE.99) THEN
322	WRITE(str2,'(i2.2)') nsrf
323	ierr = NF_REDEF (nid)
324	#ifdef NC_DOUBLE
325	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_DOUBLE,1,idim2,nvarid)
326	#else
327	ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_FLOAT,1,idim2,nvarid)
328	#endif
329	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
330	. "albedo de surface No."//str2)
331	ierr = NF_ENDDEF(nid)
332	ELSE
333	PRINT*, "Trop de sous-mailles"
334	CALL abort
335	ENDIF
336	#ifdef NC_DOUBLE
337	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1,nsrf))
338	#else
339	ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1,nsrf))
340	#endif
341	ENDDO
342	c
343	DO nsrf = 1, nbsrf
344	IF (nsrf.LE.99) THEN
345	WRITE(str2,'(i2.2)') nsrf
346	ierr = NF_REDEF (nid)
347	#ifdef NC_DOUBLE
348	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_DOUBLE,1,idim2,nvarid)
349	#else
350	ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_FLOAT,1,idim2,nvarid)
351	#endif
352	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
353	. "Evaporation de surface No."//str2)
354	ierr = NF_ENDDEF(nid)
355	ELSE
356	PRINT*, "Trop de sous-mailles"
357	CALL abort
358	ENDIF
359	#ifdef NC_DOUBLE
360	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,evap(1,nsrf))
361	#else
362	ierr = NF_PUT_VAR_REAL (nid,nvarid,evap(1,nsrf))
363	#endif
364	ENDDO
365
366	c
367	DO nsrf = 1, nbsrf
368	IF (nsrf.LE.99) THEN
369	WRITE(str2,'(i2.2)') nsrf
370	ierr = NF_REDEF (nid)
371	#ifdef NC_DOUBLE
372	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
373	#else
374	ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
375	#endif
376	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
377	. "Neige de surface No."//str2)
378	ierr = NF_ENDDEF(nid)
379	ELSE
380	PRINT*, "Trop de sous-mailles"
381	CALL abort
382	ENDIF
383	#ifdef NC_DOUBLE
384	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
385	#else
386	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
387	#endif
388	ENDDO
389
390	c
391	ierr = NF_REDEF (nid)
392	#ifdef NC_DOUBLE
393	ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
394	#else
395	ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
396	#endif
397	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
398	. "Rayonnement net a la surface")
399	ierr = NF_ENDDEF(nid)
400	#ifdef NC_DOUBLE
401	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
402	#else
403	ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
404	#endif
405	c
406	ierr = NF_REDEF (nid)
407	#ifdef NC_DOUBLE
408	ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
409	#else
410	ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
411	#endif
412	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
413	. "Rayonnement solaire a la surface")
414	ierr = NF_ENDDEF(nid)
415	#ifdef NC_DOUBLE
416	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
417	#else
418	ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
419	#endif
420	c
421	ierr = NF_REDEF (nid)
422	#ifdef NC_DOUBLE
423	ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
424	#else
425	ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
426	#endif
427	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
428	. "Rayonnement IF a la surface")
429	ierr = NF_ENDDEF(nid)
430	#ifdef NC_DOUBLE
431	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
432	#else
433	ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
434	#endif
435	c
436	ierr = NF_REDEF (nid)
437	#ifdef NC_DOUBLE
438	ierr = NF_DEF_VAR (nid, "rain_f", NF_DOUBLE, 1, idim2,nvarid)
439	#else
440	ierr = NF_DEF_VAR (nid, "rain_f", NF_FLOAT, 1, idim2,nvarid)
441	#endif
442	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
443	. "precipitation liquide")
444	ierr = NF_ENDDEF(nid)
445	#ifdef NC_DOUBLE
446	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rain_fall)
447	#else
448	ierr = NF_PUT_VAR_REAL (nid,nvarid,rain_fall)
449	#endif
450	c
451	ierr = NF_REDEF (nid)
452	#ifdef NC_DOUBLE
453	ierr = NF_DEF_VAR (nid, "snow_f", NF_DOUBLE, 1, idim2,nvarid)
454	#else
455	ierr = NF_DEF_VAR (nid, "snow_f", NF_FLOAT, 1, idim2,nvarid)
456	#endif
457	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
458	. "precipitation solide")
459	ierr = NF_ENDDEF(nid)
460	#ifdef NC_DOUBLE
461	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow_fall)
462	#else
463	ierr = NF_PUT_VAR_REAL (nid,nvarid,snow_fall)
464	#endif
465	c
466	DO nsrf = 1, nbsrf
467	IF (nsrf.LE.99) THEN
468	WRITE(str2,'(i2.2)') nsrf
469	ierr = NF_REDEF (nid)
470	#ifdef NC_DOUBLE
471	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_DOUBLE,1,idim2,nvarid)
472	#else
473	ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_FLOAT,1,idim2,nvarid)
474	#endif
475	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
476	. "rugosite de surface No."//str2)
477	ierr = NF_ENDDEF(nid)
478	ELSE
479	PRINT*, "Trop de sous-mailles"
480	CALL abort
481	ENDIF
482	#ifdef NC_DOUBLE
483	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,nsrf))
484	#else
485	ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,nsrf))
486	#endif
487	ENDDO
488	c
489	ierr = NF_REDEF (nid)
490	#ifdef NC_DOUBLE
491	ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
492	#else
493	ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
494	#endif
495	ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
496	. "Age de la neige")
497	ierr = NF_ENDDEF(nid)
498	#ifdef NC_DOUBLE
499	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
500	#else
501	ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
502	#endif
503	c
504	ierr = NF_REDEF (nid)
505	#ifdef NC_DOUBLE
506	ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
507	#else
508	ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
509	#endif
510	ierr = NF_ENDDEF(nid)
511	#ifdef NC_DOUBLE
512	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
513	#else
514	ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
515	#endif
516	c
517	ierr = NF_REDEF (nid)
518	#ifdef NC_DOUBLE
519	ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
520	#else
521	ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
522	#endif
523	ierr = NF_ENDDEF(nid)
524	#ifdef NC_DOUBLE
525	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
526	#else
527	ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
528	#endif
529	ierr = NF_REDEF (nid)
530	#ifdef NC_DOUBLE
531	ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
532	#else
533	ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
534	#endif
535	ierr = NF_ENDDEF(nid)
536	#ifdef NC_DOUBLE
537	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
538	#else
539	ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
540	#endif
541	ierr = NF_REDEF (nid)
542	#ifdef NC_DOUBLE
543	ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
544	#else
545	ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
546	#endif
547	ierr = NF_ENDDEF(nid)
548	#ifdef NC_DOUBLE
549	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
550	#else
551	ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
552	#endif
553	ierr = NF_REDEF (nid)
554	#ifdef NC_DOUBLE
555	ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
556	#else
557	ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
558	#endif
559	ierr = NF_ENDDEF(nid)
560	#ifdef NC_DOUBLE
561	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
562	#else
563	ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
564	#endif
565	ierr = NF_REDEF (nid)
566	#ifdef NC_DOUBLE
567	ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
568	#else
569	ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
570	#endif
571	ierr = NF_ENDDEF(nid)
572	#ifdef NC_DOUBLE
573	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
574	#else
575	ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
576	#endif
577	ierr = NF_REDEF (nid)
578	#ifdef NC_DOUBLE
579	ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
580	#else
581	ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
582	#endif
583	ierr = NF_ENDDEF(nid)
584	#ifdef NC_DOUBLE
585	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
586	#else
587	ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
588	#endif
589	ierr = NF_REDEF (nid)
590	#ifdef NC_DOUBLE
591	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
592	#else
593	ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
594	#endif
595	ierr = NF_ENDDEF(nid)
596	#ifdef NC_DOUBLE
597	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel)
598	#else
599	ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel)
600	#endif
601	c
602	ierr = NF_REDEF (nid)
603	#ifdef NC_DOUBLE
604	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
605	#else
606	ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
607	#endif
608	ierr = NF_ENDDEF(nid)
609	#ifdef NC_DOUBLE
610	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
611	#else
612	ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
613	#endif
614	c
615	ierr = NF_REDEF (nid)
616	#ifdef NC_DOUBLE
617	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
618	#else
619	ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
620	#endif
621	ierr = NF_ENDDEF(nid)
622	#ifdef NC_DOUBLE
623	ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
624	#else
625	ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
626	#endif
627	c
628	ierr = NF_CLOSE(nid)
629	c
630	RETURN
631	END

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

Download in other formats:

Original Format