source: LMDZ4/trunk/libf/phy_IPCC_AR4/phyredem.F @ 902

Last change on this file since 902 was 868, checked in by Laurent Fairhead, 17 years ago

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