Context Navigation

phyredem.F @ 443

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

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

Download in other formats:

Original Format