Context Navigation

phyredem.F @ 1098

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

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

Download in other formats:

Original Format