Context Navigation

phyredem.F @ 968

Last change on this file since 968 was 967, checked in by Laurent Fairhead, 18 years ago
Pour des raisons pratiques (besoin de tester facilement les parametrisations physiques en 1D et 3D), les arguments des routines de lecture et d'ecriture de l'etat initial de la physique ont disparu des appels à ces routines et sont maintenant passés par le module phys_state_var_mod LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 27.5 KB

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

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

Download in other formats:

Original Format