Context Navigation

phyredem.F @ 467

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

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

Download in other formats:

Original Format