Context Navigation

phyredem.F @ 5080

Last change on this file since 5080 was 634, checked in by Laurent Fairhead, 20 years ago
Modifications faites à la physique pour la rendre parallele YM Une branche de travail LMDZ4_par_0 a été créée provisoirement afin de tester les modifs pleinement avant leurs inclusions dans le tronc principal LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 25.1 KB

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

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

Download in other formats:

Original Format