Context Navigation

phyredem.F @ 535

Last change on this file since 535 was 522, checked in by lmdzadmin, 21 years ago
Modifications pour la fermeture en eau (fonte des glaciers) JLD, OM LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 22.7 KB

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

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

Download in other formats:

Original Format