Context Navigation

phyredem.F @ 935

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

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

Download in other formats:

Original Format