Context Navigation

phyredem.F @ 679

Last change on this file since 679 was 644, checked in by Laurent Fairhead, 20 years ago
Synchronisation avec tous les diagnostiques de Ionela IM Inclusion du slab ocean IM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 23.1 KB

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

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

Download in other formats:

Original Format