Context Navigation

phyredem.F @ 625

Last change on this file since 625 was 541, checked in by lmdzadmin, 21 years ago

Convergence avec la version d'Olivia Coindreau incluant:

le offline
les thermiques
mellor & yamada dans la couche limite

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 22.6 KB

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

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

Download in other formats:

Original Format