source: LMDZ4/trunk/libf/phytherm/phyredem.F @ 872

Last change on this file since 872 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
RevLine 
[814]1!
2! $Header$
3!
4c
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,
[852]11     .           t_ancien_p, q_ancien_p, rnebcon_p, ratqs_p, clwcon_p,
12     .           pbl_tke_p)
[814]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"
[852]32#include "thermcell.h"
33#include "compbl.h"
[814]34c======================================================================
35      CHARACTER*(*) fichnom
36      REAL dtime
37      INTEGER radpas
38      REAL rlat_p(klon), rlon_p(klon)
39      REAL tsol_p(klon,nbsrf)
[852]40      REAL pbl_tke_p(klon,klev,nbsrf)
[814]41      REAL tsoil_p(klon,nsoilmx,nbsrf)
42      CHARACTER*6 ocean
43cIM "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)
49cIM BEG
50      REAL alblw_p(klon,nbsrf)
51cIM 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)
[852]76      REAL pbl_tke(klon_glo,klev,nbsrf)
[814]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)
108c
109      INTEGER nid, nvarid, idim1, idim2, idim3
110      INTEGER ierr
111      INTEGER length
112      PARAMETER (length=100)
113      REAL tab_cntrl(length)
114c
115      INTEGER isoil, nsrf
116      CHARACTER*7 str7
117      CHARACTER*2 str2
118
119c======================================================================
120c
121c Get variables which will be written to restart file from module
122c 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
126c Get a variable calculated in module fonte_neige_mod
127      CALL fonte_neige_final(run_off_lic_0_p)
128
129c 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
137c======================================================================
138
139      call Gather( rlat_p,rlat)
140      call Gather( rlon_p,rlon)
141      call Gather( tsol_p,tsol)
[852]142      call Gather( pbl_tke_p,pbl_tke)
[814]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     
177c$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
186c
187      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
188     .                       "Fichier redemmarage physique")
189c
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)
193c
194      ierr = NF_ENDDEF(nid)
195c
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
215c
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
230c
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
245c
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
260c
261C PB ajout du masque terre/mer
262C
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     
277c BP ajout des fraction de chaque sous-surface
278C
279C 1. fraction de terre
280C
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
295C
296C 2. Fraction de glace de terre
297C
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
312C
313C 3. fraction ocean
314C
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
329C
330C 4. Fraction glace de mer
331C
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
346C
347C
348c
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
371c
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
396c
397cIM "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
412c
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
427c
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
450C
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
465c
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
489cIM 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
512cIM END albedo LW
513c
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
537c
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
561c
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
576c
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
591c
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
606c
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
621c
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
636c
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
651c
652       endif
653c$OMP END MASTER
654cc ----> necessaire pour eviter bug openMP sur SX6
655c$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
679c
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
704c
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
717c
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
802c
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
815c
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
828c
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
843c
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
858c
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
873c
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
888c
889c run_off_lic_0
890c
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
905c
906c
[852]907!!!!!!!!!!!!!!!!!!!! DEB TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
908c
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 !!!!!!!!!!!!!!!!!!!!!!!!!
937c
[814]938      ierr = NF_CLOSE(nid)
939c
940      endif   ! is_mpi_root
941c$OMP END MASTER
942      RETURN
943      END
Note: See TracBrowser for help on using the repository browser.