Context Navigation

phyredem.F @ 878

Last change on this file since 878 was 878, checked in by Laurent Fairhead, 17 years ago
Bascule de la physique du LMD vers la physique avec thermiques 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