Context Navigation

phyredem.F @ 900

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

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

Download in other formats:

Original Format