Context Navigation

phyredem.F @ 963

Last change on this file since 963 was 868, checked in by Laurent Fairhead, 17 years ago
Preparation du remplacement de la physique utilisee pour l'exercice IPCC_AR4 par la version de la physique avec thermique. On garde le repertoire phylmd pour un petit moment pour que les utilisateurs ne soient pas trop perdus ... phy_IPCC_AR4 = phylmd LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 26.5 KB

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

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

Download in other formats:

Original Format