source: LMDZ4/trunk/libf/phylmd/phyredem.F @ 939

Last change on this file since 939 was 937, checked in by lmdzadmin, 16 years ago

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