Context Navigation

phyredem.F @ 1342

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

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

Download in other formats:

Original Format