source: LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F @ 364

Last change on this file since 364 was 364, checked in by lmdzadmin, 22 years ago

Differentes modifs d'ajustement et de reglages du calendrier
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 120.2 KB
Line 
1c
2c $Header$
3c
4      SUBROUTINE physiq (nlon,nlev,nqmax  ,
5     .            debut,lafin,rjourvrai,rjour_ecri,gmtime,pdtphys,
6     .            paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
7     .            u,v,t,qx,
8     .            omega, cufi, cvfi,
9     .            d_u, d_v, d_t, d_qx, d_ps)
10      USE ioipsl
11      USE histcom
12      USE writephys
13
14      IMPLICIT none
15c======================================================================
16c
17c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
18c
19c Objet: Moniteur general de la physique du modele
20cAA      Modifications quant aux traceurs :
21cAA                  -  uniformisation des parametrisations ds phytrac
22cAA                  -  stockage des moyennes des champs necessaires
23cAA                     en mode traceur off-line
24c======================================================================
25c    modif   ( P. Le Van ,  12/10/98 )
26c
27c  Arguments:
28c
29c nlon----input-I-nombre de points horizontaux
30c nlev----input-I-nombre de couches verticales
31c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
32c debut---input-L-variable logique indiquant le premier passage
33c lafin---input-L-variable logique indiquant le dernier passage
34c rjour---input-R-numero du jour de l'experience
35c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
36c pdtphys-input-R-pas d'integration pour la physique (seconde)
37c paprs---input-R-pression pour chaque inter-couche (en Pa)
38c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
39c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
40c pphis---input-R-geopotentiel du sol
41c paire---input-R-aire de chaque maille
42c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
43c u-------input-R-vitesse dans la direction X (de O a E) en m/s
44c v-------input-R-vitesse Y (de S a N) en m/s
45c t-------input-R-temperature (K)
46c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
47c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
48c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
49c omega---input-R-vitesse verticale en Pa/s
50c cufi----input-R-resolution des mailles en x (m)
51c cvfi----input-R-resolution des mailles en y (m)
52c
53c d_u-----output-R-tendance physique de "u" (m/s/s)
54c d_v-----output-R-tendance physique de "v" (m/s/s)
55c d_t-----output-R-tendance physique de "t" (K/s)
56c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
57c d_ps----output-R-tendance physique de la pression au sol
58c======================================================================
59#include "dimensions.h"
60      integer jjmp1
61      parameter (jjmp1=jjm+1-1/jjm)
62#include "dimphy.h"
63#include "regdim.h"
64#include "indicesol.h"
65#include "dimsoil.h"
66#include "clesphys.h"
67#include "control.h"
68#include "temps.h"
69c======================================================================
70      LOGICAL check ! Verifier la conservation du modele en eau
71      PARAMETER (check=.FALSE.)
72      LOGICAL ok_stratus ! Ajouter artificiellement les stratus
73      PARAMETER (ok_stratus=.FALSE.)
74c======================================================================
75c Parametres lies au coupleur OASIS:
76#include "oasis.h"
77      INTEGER,SAVE :: npas, nexca
78      logical rnpb
79      parameter(rnpb=.true.)
80c      PARAMETER (npas=1440)
81c      PARAMETER (nexca=48)
82      EXTERNAL fromcpl, intocpl, inicma
83c      ocean = type de modele ocean a utiliser: force, slab, couple
84      character*6 ocean
85      SAVE ocean
86
87c      parameter (ocean = 'force ')
88c     parameter (ocean = 'couple')
89      logical ok_ocean
90c======================================================================
91c Clef controlant l'activation du cycle diurne:
92ccc      LOGICAL cycle_diurne
93ccc      PARAMETER (cycle_diurne=.FALSE.)
94c======================================================================
95c Modele thermique du sol, a activer pour le cycle diurne:
96ccc      LOGICAL soil_model
97ccc      PARAMETER (soil_model=.FALSE.)
98      logical ok_veget
99      save ok_veget
100c     parameter (ok_veget = .true.)
101c      parameter (ok_veget = .false.)
102c======================================================================
103c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
104c le calcul du rayonnement est celle apres la precipitation des nuages.
105c Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
106c la condensation et la precipitation. Cette cle augmente les impacts
107c radiatifs des nuages.
108ccc      LOGICAL new_oliq
109ccc      PARAMETER (new_oliq=.FALSE.)
110c======================================================================
111c Clefs controlant deux parametrisations de l'orographie:
112cc      LOGICAL ok_orodr
113ccc      PARAMETER (ok_orodr=.FALSE.)
114ccc      LOGICAL ok_orolf
115ccc      PARAMETER (ok_orolf=.FALSE.)
116c======================================================================
117      LOGICAL ok_journe ! sortir le fichier journalier
118      save ok_journe
119c      PARAMETER (ok_journe=.true.)
120c
121      LOGICAL ok_mensuel ! sortir le fichier mensuel
122      save ok_mensuel
123c      PARAMETER (ok_mensuel=.true.)
124c
125      LOGICAL ok_instan ! sortir le fichier instantane
126      save ok_instan
127c      PARAMETER (ok_instan=.true.)
128c
129      LOGICAL ok_region ! sortir le fichier regional
130      PARAMETER (ok_region=.FALSE.)
131c======================================================================
132c
133      INTEGER ivap          ! indice de traceurs pour vapeur d'eau
134      PARAMETER (ivap=1)
135      INTEGER iliq          ! indice de traceurs pour eau liquide
136      PARAMETER (iliq=2)
137
138      INTEGER nvm           ! nombre de vegetations
139      PARAMETER (nvm=8)
140      REAL veget(klon,nvm)  ! couverture vegetale
141      SAVE veget
142
143c
144c
145c Variables argument:
146c
147      INTEGER nlon
148      INTEGER nlev
149      INTEGER nqmax
150      REAL rjourvrai, rjour_ecri
151      REAL gmtime
152      REAL pdtphys
153      LOGICAL debut, lafin
154      REAL paprs(klon,klev+1)
155      REAL pplay(klon,klev)
156      REAL pphi(klon,klev)
157      REAL pphis(klon)
158      REAL paire(klon)
159      REAL presnivs(klev)
160      REAL znivsig(klev)
161      REAL zsurf(nbsrf)
162      real cufi(klon), cvfi(klon)
163
164      REAL u(klon,klev)
165      REAL v(klon,klev)
166      REAL t(klon,klev)
167      REAL qx(klon,klev,nqmax)
168
169      REAL t_ancien(klon,klev), q_ancien(klon,klev)
170      SAVE t_ancien, q_ancien
171      LOGICAL ancien_ok
172      SAVE ancien_ok
173
174      REAL d_t_dyn(klon,klev)
175      REAL d_q_dyn(klon,klev)
176
177      REAL omega(klon,klev)
178
179      REAL d_u(klon,klev)
180      REAL d_v(klon,klev)
181      REAL d_t(klon,klev)
182      REAL d_qx(klon,klev,nqmax)
183      REAL d_ps(klon)
184
185      INTEGER        longcles
186      PARAMETER    ( longcles = 20 )
187      REAL clesphy0( longcles      )
188c
189c Variables quasi-arguments
190c
191      REAL xjour
192      SAVE xjour
193c
194c
195c Variables propres a la physique
196c
197      REAL dtime
198      SAVE dtime                  ! pas temporel de la physique
199c
200      INTEGER radpas
201      SAVE radpas                 ! frequence d'appel rayonnement
202c
203      REAL radsol(klon)
204      SAVE radsol                 ! bilan radiatif au sol
205c
206      REAL rlat(klon)
207      SAVE rlat                   ! latitude pour chaque point
208c
209      REAL rlon(klon)
210      SAVE rlon                   ! longitude pour chaque point
211c
212cc      INTEGER iflag_con
213cc      SAVE iflag_con              ! indicateur de la convection
214c
215      INTEGER itap
216      SAVE itap                   ! compteur pour la physique
217c
218      REAL co2_ppm
219      SAVE co2_ppm                ! concentration du CO2
220c
221      REAL solaire
222      SAVE solaire                ! constante solaire
223c
224      REAL ftsol(klon,nbsrf)
225      SAVE ftsol                  ! temperature du sol
226c
227      REAL ftsoil(klon,nsoilmx,nbsrf)
228      SAVE ftsoil                 ! temperature dans le sol
229c
230      REAL fevap(klon,nbsrf)
231      SAVE fevap                 ! evaporation
232      REAL fluxlat(klon,nbsrf)
233      SAVE fluxlat
234c
235      REAL deltat(klon)
236      SAVE deltat                 ! ecart avec la SST de reference
237c
238      REAL fqsol(klon,nbsrf)
239      SAVE fqsol                  ! humidite du sol
240c
241      REAL fsnow(klon,nbsrf)
242      SAVE fsnow                  ! epaisseur neigeuse
243c
244      REAL falbe(klon,nbsrf)
245      SAVE falbe                  ! albedo par type de surface
246      REAL falblw(klon,nbsrf)
247      SAVE falblw                 ! albedo par type de surface
248
249c
250c
251c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
252c
253      REAL zmea(klon)
254      SAVE zmea                   ! orographie moyenne
255c
256      REAL zstd(klon)
257      SAVE zstd                   ! deviation standard de l'OESM
258c
259      REAL zsig(klon)
260      SAVE zsig                   ! pente de l'OESM
261c
262      REAL zgam(klon)
263      save zgam                   ! anisotropie de l'OESM
264c
265      REAL zthe(klon)
266      SAVE zthe                   ! orientation de l'OESM
267c
268      REAL zpic(klon)
269      SAVE zpic                   ! Maximum de l'OESM
270c
271      REAL zval(klon)
272      SAVE zval                   ! Minimum de l'OESM
273c
274      REAL rugoro(klon)
275      SAVE rugoro                 ! longueur de rugosite de l'OESM
276c
277      REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
278c
279      REAL zuthe(klon),zvthe(klon)
280      SAVE zuthe
281      SAVE zvthe
282      INTEGER igwd,idx(klon),itest(klon)
283c
284      REAL agesno(klon,nbsrf)
285      SAVE agesno                 ! age de la neige
286c
287      REAL alb_neig(klon)
288      SAVE alb_neig               ! albedo de la neige
289cKE43
290c Variables liees a la convection de K. Emanuel (sb):
291c
292      REAL ema_workcbmf(klon)   ! cloud base mass flux
293      SAVE ema_workcbmf
294
295      REAL ema_cbmf(klon)       ! cloud base mass flux
296      SAVE ema_cbmf
297
298      REAL ema_pcb(klon)        ! cloud base pressure
299      SAVE ema_pcb
300
301      REAL ema_pct(klon)        ! cloud top pressure
302      SAVE ema_pct
303
304      REAL bas, top             ! cloud base and top levels
305      SAVE bas
306      SAVE top
307
308      REAL Ma(klon,klev)        ! undilute upward mass flux
309      SAVE Ma
310      REAL ema_work1(klon, klev), ema_work2(klon, klev)
311      SAVE ema_work1, ema_work2
312      REAL wdn(klon), tdn(klon), qdn(klon)
313c Variables locales pour la couche limite (al1):
314c
315cAl1      REAL pblh(klon)           ! Hauteur de couche limite
316cAl1      SAVE pblh
317c34EK
318c
319c Variables locales:
320c
321      REAL cdragh(klon) ! drag coefficient pour T and Q
322      REAL cdragm(klon) ! drag coefficient pour vent
323cAA
324cAA  Pour phytrac
325cAA
326      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
327      REAL yu1(klon)            ! vents dans la premiere couche U
328      REAL yv1(klon)            ! vents dans la premiere couche V
329      LOGICAL offline           ! Controle du stockage ds "physique"
330      PARAMETER (offline=.false.)
331      INTEGER physid
332      REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
333      save pfrac_impa
334      REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation
335      save pfrac_nucl
336      REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)
337      save pfrac_1nucl
338      REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
339      REAL frac_nucl(klon,klev) ! idem (nucleation)
340cAA
341      REAL rain_fall(klon) ! pluie
342      REAL snow_fall(klon) ! neige
343      save snow_fall, rain_fall
344      REAL evap(klon), devap(klon) ! evaporation et sa derivee
345      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
346      REAL dlw(klon)    ! derivee infra rouge
347      REAL bils(klon) ! bilan de chaleur au sol
348      REAL fder(klon) ! Derive de flux (sensible et latente)
349      save fder
350      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
351      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
352      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
353      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
354c
355      REAL frugs(klon,nbsrf) ! longueur de rugosite
356      save frugs
357      REAL zxrugs(klon) ! longueur de rugosite
358c
359c Conditions aux limites
360c
361      INTEGER julien
362c
363      INTEGER lmt_pas
364      SAVE lmt_pas                ! frequence de mise a jour
365      REAL pctsrf(klon,nbsrf)
366      SAVE pctsrf                 ! sous-fraction du sol
367      REAL albsol(klon)
368      SAVE albsol                 ! albedo du sol total
369      REAL albsollw(klon)
370      SAVE albsollw                 ! albedo du sol total
371      REAL albsol1(klon)
372      SAVE albsol1                 ! albedo du sol total
373      REAL albsollw1(klon)
374      SAVE albsollw1                 ! albedo du sol total
375
376      REAL wo(klon,klev)
377      SAVE wo                     ! ozone
378c======================================================================
379c
380c Declaration des procedures appelees
381c
382      EXTERNAL angle     ! calculer angle zenithal du soleil
383      EXTERNAL alboc     ! calculer l'albedo sur ocean
384      EXTERNAL albsno    ! calculer albedo sur neige
385      EXTERNAL ajsec     ! ajustement sec
386      EXTERNAL clmain    ! couche limite
387      EXTERNAL condsurf  ! lire les conditions aux limites
388      EXTERNAL conlmd    ! convection (schema LMD)
389cKE43
390      EXTERNAL conema  ! convect4.3
391      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
392cAA
393      EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
394c                          ! stockage des coefficients necessaires au
395c                          ! lessivage OFF-LINE et ON-LINE
396cAA
397      EXTERNAL hgardfou  ! verifier les temperatures
398      EXTERNAL nuage     ! calculer les proprietes radiatives
399      EXTERNAL o3cm      ! initialiser l'ozone
400      EXTERNAL orbite    ! calculer l'orbite terrestre
401      EXTERNAL ozonecm   ! prescrire l'ozone
402      EXTERNAL phyetat0  ! lire l'etat initial de la physique
403      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
404      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
405      EXTERNAL suphec    ! initialiser certaines constantes
406      EXTERNAL transp    ! transport total de l'eau et de l'energie
407      EXTERNAL ecribina  ! ecrire le fichier binaire global
408      EXTERNAL ecribins  ! ecrire le fichier binaire global
409      EXTERNAL ecrirega  ! ecrire le fichier binaire regional
410      EXTERNAL ecriregs  ! ecrire le fichier binaire regional
411c
412c Variables locales
413c
414      REAL dialiq(klon,klev)  ! eau liquide nuageuse
415      REAL diafra(klon,klev)  ! fraction nuageuse
416      REAL cldliq(klon,klev)  ! eau liquide nuageuse
417      REAL cldfra(klon,klev)  ! fraction nuageuse
418      REAL cldtau(klon,klev)  ! epaisseur optique
419      REAL cldemi(klon,klev)  ! emissivite infrarouge
420c
421C§§§ PB
422      REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
423      REAL fluxt(klon,klev, nbsrf)   ! flux turbulent de chaleur
424      REAL fluxu(klon,klev, nbsrf)   ! flux turbulent de vitesse u
425      REAL fluxv(klon,klev, nbsrf)   ! flux turbulent de vitesse v
426c
427      REAL zxfluxt(klon, klev)
428      REAL zxfluxq(klon, klev)
429      REAL zxfluxu(klon, klev)
430      REAL zxfluxv(klon, klev)
431C§§§
432      REAL heat(klon,klev)    ! chauffage solaire
433      REAL heat0(klon,klev)   ! chauffage solaire ciel clair
434      REAL cool(klon,klev)    ! refroidissement infrarouge
435      REAL cool0(klon,klev)   ! refroidissement infrarouge ciel clair
436      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
437      real sollwdown(klon)    ! downward LW flux at surface
438      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
439      REAL albpla(klon)
440c Le rayonnement n'est pas calcule tous les pas, il faut donc
441c                      sauvegarder les sorties du rayonnement
442      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
443      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
444      INTEGER itaprad
445      SAVE itaprad
446c
447      REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
448      REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
449c
450      REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
451      REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
452c
453      REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
454c
455      REAL dist, rmu0(klon), fract(klon)
456      REAL zdtime, zlongi
457c
458      CHARACTER*2 str2
459      CHARACTER*2 iqn
460c
461      REAL qcheck
462      REAL z_avant(klon), z_apres(klon), z_factor(klon)
463      LOGICAL zx_ajustq
464c
465      REAL za, zb
466      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
467      INTEGER i, k, iq, nsrf, ll
468      REAL t_coup
469      PARAMETER (t_coup=234.0)
470c
471      REAL zphi(klon,klev)
472      REAL zx_tmp_x(iim), zx_tmp_yjjmp1
473      REAL zx_relief(iim,jjmp1)
474      REAL zx_aire(iim,jjmp1)
475cKE43
476c Variables locales pour la convection de K. Emanuel (sb):
477c
478      REAL upwd(klon,klev)      ! saturated updraft mass flux
479      REAL dnwd(klon,klev)      ! saturated downdraft mass flux
480      REAL dnwd0(klon,klev)     ! unsaturated downdraft mass flux
481      REAL tvp(klon,klev)       ! virtual temp of lifted parcel
482      REAL cape(klon)           ! CAPE
483      SAVE cape
484      REAL pbase(klon)          ! cloud base pressure
485      SAVE pbase
486      REAL bbase(klon)          ! cloud base buoyancy
487      SAVE bbase
488      REAL rflag(klon)          ! flag fonctionnement de convect
489      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
490c -- convect43:
491      INTEGER ntra              ! nb traceurs pour convect4.3
492      REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
493      REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
494      REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
495      REAL dplcldt(klon), dplcldr(klon)
496c?     .     condm_con(klon,klev),conda_con(klon,klev),
497c?     .     mr_con(klon,klev),ep_con(klon,klev)
498c?     .    ,sadiab(klon,klev),wadiab(klon,klev)
499c --
500c34EK
501c
502c Variables du changement
503c
504c con: convection
505c lsc: condensation a grande echelle (Large-Scale-Condensation)
506c ajs: ajustement sec
507c eva: evaporation de l'eau liquide nuageuse
508c vdf: couche limite (Vertical DiFfusion)
509      REAL d_t_con(klon,klev),d_q_con(klon,klev)
510      REAL d_u_con(klon,klev),d_v_con(klon,klev)
511      REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
512      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
513      REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
514      REAL rneb(klon,klev)
515c
516      REAL pmfu(klon,klev), pmfd(klon,klev)
517      REAL pen_u(klon,klev), pen_d(klon,klev)
518      REAL pde_u(klon,klev), pde_d(klon,klev)
519      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
520      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
521      REAL prfl(klon,klev+1), psfl(klon,klev+1)
522c
523      INTEGER ibas_con(klon), itop_con(klon)
524      REAL rain_con(klon), rain_lsc(klon)
525      REAL snow_con(klon), snow_lsc(klon)
526      REAL d_ts(klon,nbsrf)
527c
528      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
529      REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
530c
531      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
532      REAL d_t_oro(klon,klev)
533      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
534      REAL d_t_lif(klon,klev)
535
536      REAL ratqs(klon,klev)
537      integer flag_ratqs
538      real zpt_conv(klon,klev)
539
540c
541c Variables liees a l'ecriture de la bande histoire physique
542c
543      INTEGER ecrit_mth
544      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
545c
546      INTEGER ecrit_day
547      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
548c
549      INTEGER ecrit_ins
550      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
551c
552      INTEGER ecrit_reg
553      SAVE ecrit_reg   ! frequence d'ecriture
554c
555      integer itau_w   ! pas de temps ecriture = itap + itau_phy
556c
557c
558c Variables locales pour effectuer les appels en serie
559c
560      REAL t_seri(klon,klev), q_seri(klon,klev)
561      REAL ql_seri(klon,klev)
562      REAL u_seri(klon,klev), v_seri(klon,klev)
563c
564      REAL tr_seri(klon,klev,nbtr)
565      REAL d_tr(klon,klev,nbtr)
566
567      REAL zx_rh(klon,klev)
568
569      INTEGER        length
570      PARAMETER    ( length = 100 )
571      REAL tabcntr0( length       )
572c
573      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
574      REAL zx_tmp_fi2d(klon)
575      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
576      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
577c
578      INTEGER nid_day, nid_mth, nid_ins
579      SAVE nid_day, nid_mth, nid_ins
580c
581      INTEGER nhori, nvert
582      REAL zsto, zout
583      real zjulian
584      save zjulian
585
586      character*20 modname
587      character*80 abort_message
588      logical ok_sync
589      real date0
590      integer idayref
591
592C essai writephys
593      integer fid_day, fid_mth, fid_ins
594      parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
595      integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
596      parameter (prof2d_on = 1, prof3d_on = 2,
597     .           prof2d_av = 3, prof3d_av = 4)
598      character*30 nom_fichier
599      character*10 varname
600      character*40 vartitle
601      character*20 varunits
602c
603c Declaration des constantes et des fonctions thermodynamiques
604c
605#include "YOMCST.h"
606#include "YOETHF.h"
607#include "FCTTRE.h"
608c======================================================================
609      modname = 'physiq'
610      ok_sync=.TRUE.
611      IF (nqmax .LT. 2) THEN
612         PRINT*, 'eaux vapeur et liquide sont indispensables'
613         CALL ABORT
614      ENDIF
615      IF (debut) THEN
616         CALL suphec ! initialiser constantes et parametres phys.
617      ENDIF
618
619
620c======================================================================
621      xjour = rjourvrai
622c
623c Si c'est le debut, il faut initialiser plusieurs choses
624c          ********
625c
626       IF (debut) THEN
627
628c
629c appel a la lecture du run.def physique
630c
631         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
632     .                  ok_instan)
633
634         DO k = 2, nvm          ! pas de vegetation
635            DO i = 1, klon
636               veget(i,k) = 0.0
637            ENDDO
638         ENDDO
639         DO i = 1, klon
640            veget(i,1) = 1.0    ! il n'y a que du desert
641         ENDDO
642         PRINT*, 'Pas de vegetation; desert partout'
643c
644c
645c Initialiser les compteurs:
646c
647
648         frugs = 0.
649         itap    = 0
650         itaprad = 0
651c
652         CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
653     .       rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow,
654     .       falbe, fevap, rain_fall,snow_fall,solsw, sollwdown,
655     .       dlw,radsol,frugs,agesno,clesphy0,
656     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
657     .       t_ancien, q_ancien, ancien_ok )
658
659c
660         radpas = NINT( 86400./dtime/nbapp_rad)
661
662c
663         CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
664     ,                    ok_instan, ok_region )
665c
666         IF (ABS(dtime-pdtphys).GT.0.001) THEN
667            PRINT*, 'Pas physique n est pas correcte',dtime,pdtphys
668            abort_message=' See above '
669            call abort_gcm(modname,abort_message,1)
670         ENDIF
671         IF (nlon .NE. klon) THEN
672            PRINT*, 'nlon et klon ne sont pas coherents', nlon, klon
673            abort_message=' See above '
674            call abort_gcm(modname,abort_message,1)
675         ENDIF
676         IF (nlev .NE. klev) THEN
677            PRINT*, 'nlev et klev ne sont pas coherents', nlev, klev
678            abort_message=' See above '
679            call abort_gcm(modname,abort_message,1)
680         ENDIF
681c
682         IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN
683           PRINT*, 'Nbre d appels au rayonnement insuffisant'
684           PRINT*, "Au minimum 4 appels par jour si cycle diurne"
685           abort_message=' See above '
686           call abort_gcm(modname,abort_message,1)
687         ENDIF
688         PRINT*, "Clef pour la convection, iflag_con=", iflag_con
689c
690cKE43
691c Initialisation pour la convection de K.E. (sb):
692         IF (iflag_con.GE.3) THEN
693
694         PRINT*, "*** Convection de Kerry Emanuel 4.3  "
695         PRINT*, "On va utiliser le melange convectif des traceurs qui"
696         PRINT*, "est calcule dans convect4.3"
697         PRINT*, " !!! penser aux logical flags de phytrac"
698
699          DO i = 1, klon
700           ema_cbmf(i) = 0.
701           ema_pcb(i)  = 0.
702           ema_pct(i)  = 0.
703           ema_workcbmf(i) = 0.
704          ENDDO
705         ENDIF
706c34EK
707         IF (ok_orodr) THEN
708         DO i=1,klon
709         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
710         ENDDO
711         CALL SUGWD(klon,klev,paprs,pplay)
712         DO i=1,klon
713         zuthe(i)=0.
714         zvthe(i)=0.
715         if(zstd(i).gt.10.)then
716           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
717           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
718         endif
719         ENDDO
720         ENDIF
721c
722c
723         lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
724         PRINT*,'La frequence de lecture surface est de ', lmt_pas
725c
726         ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
727         IF (ok_mensuel) THEN
728         PRINT*, 'La frequence de sortie mensuelle est de ', ecrit_mth
729         ENDIF
730         ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
731         IF (ok_journe) THEN
732         PRINT*, 'La frequence de sortie journaliere est de ',ecrit_day
733         ENDIF
734ccc         ecrit_ins = NINT(86400./dtime *0.5)  ! 2 fois par jour
735ccc         ecrit_ins = NINT(86400./dtime *0.25)  ! 4 fois par jour
736         ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
737         ecrit_ins = NINT(86400./dtime/48.)  ! a chaque pas de temps
738         IF (ok_instan) THEN
739         PRINT*, 'La frequence de sortie instant. est de ', ecrit_ins
740         ENDIF
741         ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
742         IF (ok_region) THEN
743         PRINT*, 'La frequence de sortie region est de ', ecrit_reg
744         ENDIF
745
746c
747c Initialiser le couplage si necessaire
748c
749      npas = 0
750      nexca = 0
751      if (ocean == 'couple') then
752        npas = itaufin/ iphysiq
753        nexca = 86400 / dtime
754        write(*,*)' ##### Ocean couple #####'
755        write(*,*)' Valeurs des pas de temps'
756        write(*,*)' npas = ', npas
757        write(*,*)' nexca = ', nexca
758      endif       
759c
760c
761c Gestion calendrier
762
763c
764      IF (ok_journe) THEN
765c
766         idayref = day_ref
767         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
768c
769         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
770         DO i = 1, iim
771            zx_lon(i,1) = rlon(i+1)
772            zx_lon(i,jjmp1) = rlon(i+1)
773         ENDDO
774         DO ll=1,klev
775            znivsig(ll)=float(ll)
776         ENDDO
777         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
778         write(*,*)'zx_lon = ',zx_lon(:,1)
779         write(*,*)'zx_lat = ',zx_lat(1,:)
780         CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
781     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
782     .                 nhori, nid_day)
783         write(*,*)'Journee ', itau_phy, zjulian
784         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
785     .                 klev, presnivs, nvert)
786c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
787c    .              klev, znivsig, nvert)
788c
789         zsto = dtime
790         zout = dtime * FLOAT(ecrit_day)
791C Essai writephys
792c        nom_fichier = 'histday1'
793c        call writephy_ini(fid_day,nom_fichier,klon,iim,jjmp1,klev,
794c    .                     rlon,rlat, presnivs,
795c    .                     zjulian, dtime)
796c        call writephy_def(prof2d_on, fid_day, "once", zsto, zout, 0)
797c        call writephy_def(prof3d_on, fid_day, "once", zsto, zout,
798c    .                                                         klev)
799c        call writephy_def(prof2d_av, fid_day, "ave(X)", zsto, zout, 0)
800c        call writephy_def(prof3d_av, fid_day, "ave(X)", zsto, zout,
801c    .                                                         klev)
802 
803c
804         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
805     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
806     .                "once", zsto,zout)
807c
808         CALL histdef(nid_day, "aire", "Grid area", "-",
809     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
810     .                "once", zsto,zout)
811c
812c Champs 2D:
813c
814         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
815     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
816     .                "ave(X)", zsto,zout)
817c
818         CALL histdef(nid_day, "tter", "Surface Temperature", "K",
819     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
820     .                "ave(X)", zsto,zout)
821c
822         CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
823     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
824     .                "ave(X)", zsto,zout)
825c
826         CALL histdef(nid_day, "toce", "Surface Temperature", "K",
827     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
828     .                "ave(X)", zsto,zout)
829c
830         CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
831     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
832     .                "ave(X)", zsto,zout)
833c
834         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
835     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
836     .                "ave(X)", zsto,zout)
837c
838         CALL histdef(nid_day, "rain", "Precipitation", "mm/day",
839     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
840     .                "ave(X)", zsto,zout)
841c
842         CALL histdef(nid_day, "snow", "Snow fall", "mm/day",
843     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
844     .                "ave(X)", zsto,zout)
845c
846         CALL histdef(nid_day, "snow_cov", "Snow cover", "mm",
847     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
848     .                "ave(X)", zsto,zout)
849c
850         CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
851     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
852     .                "ave(X)", zsto,zout)
853c
854         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
855     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
856     .                "ave(X)", zsto,zout)
857c
858         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
859     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
860     .                "ave(X)", zsto,zout)
861c
862         CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
863     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
864     .                "ave(X)", zsto,zout)
865c
866         CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
867     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
868     .                "ave(X)", zsto,zout)
869c
870         CALL histdef(nid_day, "solldown", "Down. IR rad. at surface",
871     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
872     .                "ave(X)", zsto,zout)
873c
874         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
875     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
876     .                "ave(X)", zsto,zout)
877c
878         CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
879     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
880     .                "ave(X)", zsto,zout)
881c
882         CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
883     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
884     .                "ave(X)", zsto,zout)
885c
886         CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
887     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
888     .                "ave(X)", zsto,zout)
889c
890         CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
891     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
892     .                "ave(X)", zsto,zout)
893c
894C §§§ PB flux pour chauqe sous surface
895C
896         DO nsrf = 1, nbsrf
897C
898           call histdef(nid_day, "pourc_"//clnsurf(nsrf),
899     $         "Fraction"//clnsurf(nsrf), "W/m2", 
900     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
901     $         "ave(X)", zsto,zout)
902C
903           call histdef(nid_day, "tsol_"//clnsurf(nsrf),
904     $         "Fraction"//clnsurf(nsrf), "W/m2", 
905     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
906     $         "ave(X)", zsto,zout)
907C
908           call histdef(nid_day, "sens_"//clnsurf(nsrf),
909     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
910     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
911     $         "ave(X)", zsto,zout)
912c
913           call histdef(nid_day, "lat_"//clnsurf(nsrf),
914     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
915     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
916     $         "ave(X)", zsto,zout)
917C
918           call histdef(nid_day, "taux_"//clnsurf(nsrf),
919     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
920     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
921     $         "ave(X)", zsto,zout)
922
923           call histdef(nid_day, "tauy_"//clnsurf(nsrf),
924     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
925     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
926     $         "ave(X)", zsto,zout)
927C
928           call histdef(nid_day, "albe_"//clnsurf(nsrf),
929     $         "Albedo surf. "//clnsurf(nsrf), "W/m2", 
930     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
931     $         "ave(X)", zsto,zout)
932C
933           call histdef(nid_day, "rugs_"//clnsurf(nsrf),
934     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
935     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
936     $         "ave(X)", zsto,zout)
937
938C§§§
939         END DO
940           
941         CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
942     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
943     .                "ave(X)", zsto,zout)
944c
945         CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
946     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
947     .                "ave(X)", zsto,zout)
948c
949         CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
950     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
951     .                "ave(X)", zsto,zout)
952c
953         CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
954     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
955     .                "ave(X)", zsto,zout)
956c
957         CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
958     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
959     .                "ave(X)", zsto,zout)
960c
961         CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
962     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
963     .                "ave(X)", zsto,zout)
964c
965c Champs 3D:
966c
967         CALL histdef(nid_day, "temp", "Air temperature", "K",
968     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
969     .                "ave(X)", zsto,zout)
970c
971         CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
972     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
973     .                "ave(X)", zsto,zout)
974c
975         CALL histdef(nid_day, "geop", "Geopotential height", "m",
976     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
977     .                "ave(X)", zsto,zout)
978c
979         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
980     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
981     .                "ave(X)", zsto,zout)
982c
983         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
984     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
985     .                "ave(X)", zsto,zout)
986c
987         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
988     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
989     .                "ave(X)", zsto,zout)
990c
991         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
992     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
993     .                "ave(X)", zsto,zout)
994c
995         CALL histend(nid_day)
996c
997         ndex2d = 0
998         ndex3d = 0
999c
1000      ENDIF ! fin de test sur ok_journe
1001c
1002      IF (ok_mensuel) THEN
1003c
1004         idayref = day_ref
1005         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
1006c
1007         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1008         DO i = 1, iim
1009            zx_lon(i,1) = rlon(i+1)
1010            zx_lon(i,jjmp1) = rlon(i+1)
1011         ENDDO
1012         DO ll=1,klev
1013            znivsig(ll)=float(ll)
1014         ENDDO
1015         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1016         CALL histbeg("histmth.nc", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
1017     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
1018     .                 nhori, nid_mth)
1019         write(*,*)'Mensuel ', itau_phy, zjulian
1020         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
1021     .                 klev, presnivs, nvert)
1022c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
1023c    .              klev, znivsig, nvert)
1024c
1025         zsto = dtime
1026         zout = dtime * ecrit_mth
1027c
1028         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
1029     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1030     .                "once",  zsto,zout)
1031c
1032         CALL histdef(nid_mth, "aire", "Grid area", "-",
1033     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1034     .                "once",  zsto,zout)
1035c
1036c Champs 2D:
1037c
1038         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
1039     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1040     .                "ave(X)", zsto,zout)
1041c
1042         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
1043     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1044     .                "ave(X)", zsto,zout)
1045c
1046         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
1047     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1048     .                "ave(X)", zsto,zout)
1049c
1050         CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
1051     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1052     .                "ave(X)", zsto,zout)
1053c
1054         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
1055     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1056     .                "ave(X)", zsto,zout)
1057c
1058         CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
1059     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1060     .                "ave(X)", zsto,zout)
1061c
1062         CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
1063     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1064     .                "ave(X)", zsto,zout)
1065c
1066         CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
1067     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1068     .                "ave(X)", zsto,zout)
1069c
1070         CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
1071     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1072     .                "ave(X)", zsto,zout)
1073c
1074         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
1075     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1076     .                "ave(X)", zsto,zout)
1077c
1078         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
1079     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1080     .                "ave(X)", zsto,zout)
1081c
1082         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
1083     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1084     .                "ave(X)", zsto,zout)
1085c
1086         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
1087     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1088     .                "ave(X)", zsto,zout)
1089c
1090         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
1091     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1092     .                "ave(X)", zsto,zout)
1093c
1094         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
1095     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1096     .                "ave(X)", zsto,zout)
1097c
1098         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
1099     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1100     .                "ave(X)", zsto,zout)
1101c
1102         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
1103     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1104     .                "ave(X)", zsto,zout)
1105c
1106         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
1107     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1108     .                "ave(X)", zsto,zout)
1109c
1110         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
1111     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1112     .                "ave(X)", zsto,zout)
1113c
1114         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
1115     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1116     .                "ave(X)", zsto,zout)
1117c
1118         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
1119     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1120     .                "ave(X)", zsto,zout)
1121c
1122         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
1123     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1124     .                "ave(X)", zsto,zout)
1125c
1126         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
1127     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1128     .                "ave(X)", zsto,zout)
1129c
1130         DO nsrf = 1, nbsrf
1131C
1132           call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1133     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1134     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1135     $         "ave(X)", zsto,zout)
1136C
1137           call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
1138     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1139     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1140     $         "ave(X)", zsto,zout)
1141C
1142           call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1143     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
1144     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1145     $         "ave(X)", zsto,zout)
1146c
1147           call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1148     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1149     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1150     $         "ave(X)", zsto,zout)
1151C
1152           call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1153     $         "Zonal wind stress"//clnsurf(nsrf), "Pa", 
1154     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1155     $         "ave(X)", zsto,zout)
1156
1157           call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1158     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
1159     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1160     $         "ave(X)", zsto,zout)
1161c
1162           call histdef(nid_mth, "albe_"//clnsurf(nsrf),
1163     $         "Albedo surf. "//clnsurf(nsrf), "W/m2", 
1164     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1165     $         "ave(X)", zsto,zout)
1166c
1167           call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
1168     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1169     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1170     $         "ave(X)", zsto,zout)
1171c
1172         CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
1173     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1174     .                "ave(X)", zsto,zout)
1175
1176         END DO
1177C
1178         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1179     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1180     .                "ave(X)", zsto,zout)
1181c
1182         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1183     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1184     .                "ave(X)", zsto,zout)
1185         CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
1186     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1187     .                "ave(X)", zsto,zout)
1188c
1189         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1190     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1191     .                "ave(X)", zsto,zout)
1192c
1193         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1194     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1195     .                "ave(X)", zsto,zout)
1196c
1197         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1198     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1199     .                "ave(X)", zsto,zout)
1200c
1201         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1202     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1203     .                "ave(X)", zsto,zout)
1204c
1205         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1206     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1207     .                "ave(X)", zsto,zout)
1208c
1209         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1210     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1211     .                "ave(X)", zsto,zout)
1212c
1213         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1214     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1215     .                "ave(X)", zsto,zout)
1216c
1217         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1218     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1219     .                "ave(X)", zsto,zout)
1220c
1221         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1222     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1223     .                "ave(X)", zsto,zout)
1224c
1225         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1226     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1227     .                "ave(X)", zsto,zout)
1228c
1229         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1230     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1231     .                "ave(X)", zsto,zout)
1232cKE43
1233      IF (iflag_con .GE. 3) THEN ! sb
1234c
1235         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
1236     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1237     .                "ave(X)", zsto,zout)
1238c
1239         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
1240     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1241     .                "ave(X)", zsto,zout)
1242c
1243         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
1244     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1245     .                "ave(X)", zsto,zout)
1246c
1247         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
1248     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1249     .                "ave(X)", zsto,zout)
1250c
1251c
1252      ENDIF
1253c34EK
1254c
1255c Champs 3D:
1256c
1257         CALL histdef(nid_mth, "temp", "Air temperature", "K",
1258     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1259     .                "ave(X)", zsto,zout)
1260c
1261         CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1262     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1263     .                "ave(X)", zsto,zout)
1264c
1265         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1266     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1267     .                "ave(X)", zsto,zout)
1268c
1269         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1270     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1271     .                "ave(X)", zsto,zout)
1272c
1273         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1274     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1275     .                "ave(X)", zsto,zout)
1276c
1277         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1278     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1279     .                "ave(X)", zsto,zout)
1280c
1281         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1282     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1283     .                "ave(X)", zsto,zout)
1284c
1285         CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1286     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1287     .                "ave(X)", zsto,zout)
1288c
1289         CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1290     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1291     .                "ave(X)", zsto,zout)
1292c
1293         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1294     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1295     .                "ave(X)", zsto,zout)
1296c
1297         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1298     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1299     .                "ave(X)", zsto,zout)
1300c
1301         CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1302     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1303     .                "ave(X)", zsto,zout)
1304c
1305         CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1306     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1307     .                "ave(X)", zsto,zout)
1308c
1309         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1310     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1311     .                "ave(X)", zsto,zout)
1312c
1313         CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1314     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1315     .                "ave(X)", zsto,zout)
1316c
1317         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1318     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1319     .                "ave(X)", zsto,zout)
1320c
1321         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1322     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1323     .                "ave(X)", zsto,zout)
1324c
1325         CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1326     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1327     .                "ave(X)", zsto,zout)
1328c
1329         CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1330     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1331     .                "ave(X)", zsto,zout)
1332c
1333         CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1334     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1335     .                "ave(X)", zsto,zout)
1336
1337         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
1338     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1339     .                "ave(X)", zsto,zout)
1340
1341         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1342     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1343     .                "ave(X)", zsto,zout)
1344
1345c
1346         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1347     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1348     .                "ave(X)", zsto,zout)
1349
1350         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1351     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1352     .                "ave(X)", zsto,zout)
1353c
1354         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1355     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1356     .                "ave(X)", zsto,zout)
1357c
1358         CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1359     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1360     .                "ave(X)", zsto,zout)
1361c
1362         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1363     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1364     .                "ave(X)", zsto,zout)
1365c
1366         CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1367     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1368     .                "ave(X)", zsto,zout)
1369c
1370         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1371     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1372     .                "ave(X)", zsto,zout)
1373c
1374         CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1375     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1376     .                "ave(X)", zsto,zout)
1377c
1378         IF (ok_orodr) THEN
1379         CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1380     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1381     .                "ave(X)", zsto,zout)
1382c
1383         CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1384     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1385     .                "ave(X)", zsto,zout)
1386c
1387         ENDIF
1388C
1389         IF (ok_orolf) THEN
1390         CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1391     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1392     .                "ave(X)", zsto,zout)
1393c
1394         CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1395     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1396     .                "ave(X)", zsto,zout)
1397         ENDIF
1398C
1399         CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1400     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1401     .                "ave(X)", zsto,zout)
1402c
1403         if (nqmax.GE.3) THEN
1404         DO iq=1,nqmax-2
1405         IF (iq.LE.99) THEN
1406         WRITE(str2,'(i2.2)') iq
1407         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1408     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1409     .                "ave(X)", zsto,zout)
1410         ELSE
1411         PRINT*, "Trop de traceurs"
1412         CALL abort
1413         ENDIF
1414         ENDDO
1415         ENDIF
1416c
1417cKE43
1418      IF (iflag_con.GE.3) THEN ! (sb)
1419c
1420         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
1421     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1422     .                "ave(X)", zsto,zout)
1423c
1424         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
1425     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1426     .                "ave(X)", zsto,zout)
1427c
1428         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
1429     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1430     .                "ave(X)", zsto,zout)
1431c
1432         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
1433     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1434     .                "ave(X)", zsto,zout)
1435c
1436c
1437      ENDIF
1438c34EK
1439         CALL histend(nid_mth)
1440c
1441         ndex2d = 0
1442         ndex3d = 0
1443c
1444      ENDIF ! fin de test sur ok_mensuel
1445c
1446c
1447      IF (ok_instan) THEN
1448c
1449         idayref = day_ref
1450         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
1451c
1452         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1453         DO i = 1, iim
1454            zx_lon(i,1) = rlon(i+1)
1455            zx_lon(i,jjmp1) = rlon(i+1)
1456         ENDDO
1457         DO ll=1,klev
1458            znivsig(ll)=float(ll)
1459         ENDDO
1460         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1461         CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
1462     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
1463     .                 nhori, nid_ins)
1464         write(*,*)'Inst ', itau_phy, zjulian
1465         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1466     .                 klev, presnivs, nvert)
1467c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1468c    .              klev, znivsig, nvert)
1469c
1470c
1471         zsto = dtime * ecrit_ins
1472         zout = dtime * ecrit_ins
1473C
1474         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1475     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1476     .                "once", zsto,zout)
1477c
1478         CALL histdef(nid_ins, "aire", "Grid area", "-",
1479     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1480     .                "once", zsto,zout)
1481c
1482c Champs 2D:
1483c
1484        CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1485     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1486     .                "inst(X)", zsto,zout)
1487c
1488        CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1489     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1490     .                "inst(X)", zsto,zout)
1491c
1492         CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
1493     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1494     .                "inst(X)", zsto,zout)
1495c
1496         CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
1497     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1498     .                "inst(X)", zsto,zout)
1499
1500        CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
1501     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1502     .                "inst(X)", zsto,zout)
1503c
1504         CALL histdef(nid_ins, "rain", "Precipitation", "mm/day",
1505     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1506     .                "inst(X)", zsto,zout)
1507c
1508         CALL histdef(nid_ins, "snow", "Snow fall", "mm/day",
1509     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1510     .                "inst(X)", zsto,zout)
1511c
1512         CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
1513     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1514     .                "inst(X)", zsto,zout)
1515c
1516         CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1517     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1518     .                "inst(X)", zsto,zout)
1519c
1520         CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1521     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1522     .                "inst(X)", zsto,zout)
1523c
1524         CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1525     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1526     .                "inst(X)", zsto,zout)
1527c
1528         CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1529     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1530     .                "inst(X)", zsto,zout)
1531c
1532         CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
1533     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1534     .                "inst(X)", zsto,zout)
1535c
1536         CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1537     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1538     .                "inst(X)", zsto,zout)
1539c
1540         CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1541     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1542     .                "inst(X)", zsto,zout)
1543c
1544         CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1545     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1546     .                "inst(X)", zsto,zout)
1547c
1548      CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1549     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1550     .                "inst(X)", zsto,zout)
1551c
1552      CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1553     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1554     .                "inst(X)", zsto,zout)
1555c
1556      CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1557     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1558     .                "inst(X)", zsto,zout)
1559c
1560      CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1561     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1562     .                "inst(X)", zsto,zout)
1563
1564         DO nsrf = 1, nbsrf
1565C
1566           call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1567     $         "Fraction"//clnsurf(nsrf), "W/m2", 
1568     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1569     $         "inst(X)", zsto,zout)
1570
1571           call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1572     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
1573     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1574     $         "inst(X)", zsto,zout)
1575c
1576           call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1577     $         "Surface Temperature"//clnsurf(nsrf), "W/m2", 
1578     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1579     $         "inst(X)", zsto,zout)
1580c
1581           call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1582     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1583     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1584     $         "inst(X)", zsto,zout)
1585C
1586           call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1587     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
1588     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1589     $         "inst(X)", zsto,zout)
1590
1591           call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1592     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
1593     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1594     $         "inst(X)", zsto,zout)
1595c
1596           call histdef(nid_ins, "albe_"//clnsurf(nsrf),
1597     $         "Albedo "//clnsurf(nsrf), "-", 
1598     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1599     $         "inst(X)", zsto,zout)
1600c
1601           call histdef(nid_ins, "rugs_"//clnsurf(nsrf),
1602     $         "rugosite "//clnsurf(nsrf), "-", 
1603     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1604     $         "inst(X)", zsto,zout)
1605C§§§
1606         END DO
1607         CALL histdef(nid_ins, "rugs", "rugosity", "-",
1608     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1609     .                "inst(X)", zsto,zout)
1610
1611c
1612         CALL histdef(nid_ins, "albs", "Surface albedo", "-",
1613     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1614     .                "inst(X)", zsto,zout)
1615         CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
1616     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1617     .                "inst(X)", zsto,zout)
1618c
1619c
1620c Champs 3D:
1621c
1622         CALL histdef(nid_ins, "temp", "Temperature", "K",
1623     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1624     .                "inst(X)", zsto,zout)
1625c
1626         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1627     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1628     .                "inst(X)", zsto,zout)
1629c
1630         CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1631     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1632     .                "inst(X)", zsto,zout)
1633c
1634         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1635     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1636     .                "inst(X)", zsto,zout)
1637c
1638         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1639     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1640     .                "inst(X)", zsto,zout)
1641c
1642         CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1643     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1644     .                "inst(X)", zsto,zout)
1645c
1646         CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1647     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1648     .                "inst(X)", zsto,zout)
1649c
1650
1651         CALL histend(nid_ins)
1652c
1653         ndex2d = 0
1654         ndex3d = 0
1655c
1656      ENDIF
1657
1658c$$$PB Positionner date0 pour initialisation de ORCHIDEE
1659      date0 = zjulian
1660C      date0 = day_ini
1661      WRITE(*,*) 'physiq date0 : ',date0
1662c
1663c
1664c
1665c Prescrire l'ozone dans l'atmosphere
1666c
1667c
1668cc         DO i = 1, klon
1669cc         DO k = 1, klev
1670cc            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1671cc         ENDDO
1672cc         ENDDO
1673c
1674c
1675      ENDIF
1676c
1677c   ****************     Fin  de   IF ( debut  )   ***************
1678c
1679c
1680c Mettre a zero des variables de sortie (pour securite)
1681c
1682      DO i = 1, klon
1683         d_ps(i) = 0.0
1684      ENDDO
1685      DO k = 1, klev
1686      DO i = 1, klon
1687         d_t(i,k) = 0.0
1688         d_u(i,k) = 0.0
1689         d_v(i,k) = 0.0
1690      ENDDO
1691      ENDDO
1692      DO iq = 1, nqmax
1693      DO k = 1, klev
1694      DO i = 1, klon
1695         d_qx(i,k,iq) = 0.0
1696      ENDDO
1697      ENDDO
1698      ENDDO
1699c
1700c Ne pas affecter les valeurs entrees de u, v, h, et q
1701c
1702      DO k = 1, klev
1703      DO i = 1, klon
1704         t_seri(i,k)  = t(i,k)
1705         u_seri(i,k)  = u(i,k)
1706         v_seri(i,k)  = v(i,k)
1707         q_seri(i,k)  = qx(i,k,ivap)
1708         ql_seri(i,k) = qx(i,k,iliq)
1709      ENDDO
1710      ENDDO
1711      IF (nqmax.GE.3) THEN
1712      DO iq = 3, nqmax
1713      DO  k = 1, klev
1714      DO  i = 1, klon
1715         tr_seri(i,k,iq-2) = qx(i,k,iq)
1716      ENDDO
1717      ENDDO
1718      ENDDO
1719      ELSE
1720      DO k = 1, klev
1721      DO i = 1, klon
1722         tr_seri(i,k,1) = 0.0
1723      ENDDO
1724      ENDDO
1725      ENDIF
1726c
1727c Diagnostiquer la tendance dynamique
1728c
1729      IF (ancien_ok) THEN
1730         DO k = 1, klev
1731         DO i = 1, klon
1732            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1733            d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1734         ENDDO
1735         ENDDO
1736      ELSE
1737         DO k = 1, klev
1738         DO i = 1, klon
1739            d_t_dyn(i,k) = 0.0
1740            d_q_dyn(i,k) = 0.0
1741         ENDDO
1742         ENDDO
1743         ancien_ok = .TRUE.
1744      ENDIF
1745c
1746c Ajouter le geopotentiel du sol:
1747c
1748      DO k = 1, klev
1749      DO i = 1, klon
1750         zphi(i,k) = pphi(i,k) + pphis(i)
1751      ENDDO
1752      ENDDO
1753c
1754c Verifier les temperatures
1755c
1756      CALL hgardfou(t_seri,ftsol,'debutphy')
1757c
1758c Incrementer le compteur de la physique
1759c
1760      itap   = itap + 1
1761      julien = MOD(NINT(xjour),360)
1762c
1763c Mettre en action les conditions aux limites (albedo, sst, etc.).
1764c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1765c
1766      IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1767         PRINT *,' PHYS cond  julien ',julien
1768         CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1769      ENDIF
1770c
1771c Re-evaporer l'eau liquide nuageuse
1772c
1773      DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
1774      DO i = 1, klon
1775         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1776         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1777         zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1778         zb = MAX(0.0,ql_seri(i,k))
1779         za = - MAX(0.0,ql_seri(i,k))
1780     .                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
1781         t_seri(i,k) = t_seri(i,k) + za
1782         q_seri(i,k) = q_seri(i,k) + zb
1783         ql_seri(i,k) = 0.0
1784         d_t_eva(i,k) = za
1785         d_q_eva(i,k) = zb
1786      ENDDO
1787      ENDDO
1788c
1789c Appeler la diffusion verticale (programme de couche limite)
1790c
1791      DO i = 1, klon
1792c       if (.not. ok_veget) then
1793c          frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
1794c       endif
1795c         frugs(i,is_lic) = rugoro(i)
1796c         frugs(i,is_oce) = rugmer(i)
1797c         frugs(i,is_sic) = 0.001
1798         zxrugs(i) = 0.0
1799      ENDDO
1800      DO nsrf = 1, nbsrf
1801      DO i = 1, klon
1802         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1803      ENDDO
1804      ENDDO
1805      DO nsrf = 1, nbsrf
1806      DO i = 1, klon
1807            zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1808      ENDDO
1809      ENDDO
1810c
1811C calculs necessaires au calcul de l'albedo dans l'interface
1812c
1813      CALL orbite(FLOAT(julien),zlongi,dist)
1814      IF (cycle_diurne) THEN
1815        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1816        CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1817      ELSE
1818        rmu0 = -999.999
1819      ENDIF
1820
1821      fder = dlw
1822
1823      CALL clmain(dtime,itap,date0,pctsrf,
1824     e            t_seri,q_seri,u_seri,v_seri,
1825     e            julien, rmu0,
1826     e            ok_veget, ocean, npas, nexca, ftsol,
1827     $            soil_model,ftsoil,
1828     $            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,falblw,
1829     $            fluxlat,
1830     e            rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
1831     e            rlon, rlat, cufi, cvfi, frugs,
1832     e            debut, lafin, agesno,rugoro ,
1833     s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1834     s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
1835     s            dsens, devap,
1836     s            ycoefh,yu1,yv1)
1837
1838c
1839C§§§ PB
1840C§§§ Incrementation des flux
1841C§§
1842      zxfluxt=0.
1843      zxfluxq=0.
1844      zxfluxu=0.
1845      zxfluxv=0.
1846      DO nsrf = 1, nbsrf
1847        DO k = 1, klev
1848          DO i = 1, klon
1849            zxfluxt(i,k) = zxfluxt(i,k) +
1850     $          fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1851            zxfluxq(i,k) = zxfluxq(i,k) +
1852     $          fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1853            zxfluxu(i,k) = zxfluxu(i,k) +
1854     $          fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1855            zxfluxv(i,k) = zxfluxv(i,k) +
1856     $          fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1857          END DO
1858        END DO
1859      END DO
1860      DO i = 1, klon
1861         sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1862c         evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1863         evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1864         fder(i) = dlw(i) + dsens(i) + devap(i)
1865      ENDDO
1866
1867
1868      DO k = 1, klev
1869      DO i = 1, klon
1870         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1871         q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1872         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1873         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1874      ENDDO
1875      ENDDO
1876c
1877c Incrementer la temperature du sol
1878c
1879      DO i = 1, klon
1880         zxtsol(i) = 0.0
1881         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1882     $       pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)
1883     $       THEN
1884             WRITE(*,*) 'physiq : pb sous surface au point ', i,
1885     $           pctsrf(i, 1 : nbsrf)
1886         ENDIF
1887      ENDDO
1888      DO nsrf = 1, nbsrf
1889      DO i = 1, klon
1890c$$$        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1891            ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1892            zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1893c$$$        ENDIF
1894      ENDDO
1895      ENDDO
1896
1897c
1898c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1899c
1900      DO nsrf = 1, nbsrf
1901        DO i = 1, klon
1902          IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
1903        ENDDO
1904      ENDDO
1905
1906c
1907c Calculer la derive du flux infrarouge
1908c
1909c$$$      DO nsrf = 1, nbsrf
1910      DO i = 1, klon
1911c$$$        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1912            dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3
1913c$$$     .          *(ftsol(i,nsrf)-zxtsol(i))
1914c$$$     .          *pctsrf(i,nsrf)
1915c$$$        ENDIF
1916c$$$      ENDDO
1917      ENDDO
1918c
1919c Appeler la convection (au choix)
1920c
1921      DO k = 1, klev
1922      DO i = 1, klon
1923         conv_q(i,k) = d_q_dyn(i,k)
1924     .               + d_q_vdf(i,k)/dtime
1925         conv_t(i,k) = d_t_dyn(i,k)
1926     .               + d_t_vdf(i,k)/dtime
1927      ENDDO
1928      ENDDO
1929      IF (check) THEN
1930         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1931         PRINT*, "avantcon=", za
1932      ENDIF
1933      zx_ajustq = .FALSE.
1934      IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1935      IF (zx_ajustq) THEN
1936         DO i = 1, klon
1937            z_avant(i) = 0.0
1938         ENDDO
1939         DO k = 1, klev
1940         DO i = 1, klon
1941            z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1942     .                        *(paprs(i,k)-paprs(i,k+1))/RG
1943         ENDDO
1944         ENDDO
1945      ENDIF
1946      IF (iflag_con.EQ.1) THEN
1947          stop'reactiver le call conlmd dans physiq.F'
1948c     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1949c    .             d_t_con, d_q_con,
1950c    .             rain_con, snow_con, ibas_con, itop_con)
1951      ELSE IF (iflag_con.EQ.2) THEN
1952      CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1953     e            conv_t, conv_q, zxfluxq(1,1), omega,
1954     s            d_t_con, d_q_con, rain_con, snow_con,
1955     s            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1956     s            kcbot, kctop, kdtop, pmflxr, pmflxs)
1957      WHERE (rain_con < 0.) rain_con = 0.
1958      WHERE (snow_con < 0.) snow_con = 0.
1959      DO i = 1, klon
1960         ibas_con(i) = klev+1 - kcbot(i)
1961         itop_con(i) = klev+1 - kctop(i)
1962      ENDDO
1963      ELSE IF (iflag_con.GE.3) THEN
1964c nb of tracers for the KE convection:
1965          if (nqmax .GE. 4) then
1966              ntra = nbtr
1967          else
1968              ntra = 1
1969          endif
1970          if (iflag_con.eq.4) then ! vectorise
1971          CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1972     .        u_seri,v_seri,tr_seri,nbtr,
1973     .        ema_work1,ema_work2,
1974     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1975     .        rain_con, snow_con, ibas_con, itop_con,
1976     .        upwd,dnwd,dnwd0,
1977c    .        Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
1978     .        Ma,cape,tvp,iflagctrl,
1979     .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1980
1981          else
1982
1983          CALL conema (dtime,paprs,pplay,t_seri,q_seri,
1984     .        u_seri,v_seri,tr_seri,nbtr,
1985     .        ema_work1,ema_work2,
1986     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1987     .        rain_con, snow_con, ibas_con, itop_con,
1988     .        upwd,dnwd,dnwd0,bas,top,
1989     .        Ma,cape,tvp,rflag,
1990     .       pbase
1991     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1992          endif
1993          DO i = 1, klon
1994            ema_pcb(i)  = pbase(i)
1995          ENDDO
1996          DO i = 1, klon
1997            ema_pct(i)  = paprs(i,itop_con(i))
1998          ENDDO
1999          DO i = 1, klon
2000            ema_cbmf(i) = ema_workcbmf(i)
2001          ENDDO     
2002      ELSE
2003          PRINT*, "iflag_con non-prevu", iflag_con
2004          CALL abort
2005      ENDIF
2006
2007c     CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2008c    .              d_u_con, d_v_con)
2009      DO k = 1, klev
2010        DO i = 1, klon
2011         t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2012         q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2013         u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2014         v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2015        ENDDO
2016      ENDDO
2017      IF (check) THEN
2018          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2019          PRINT*, "aprescon=", za
2020          zx_t = 0.0
2021          za = 0.0
2022          DO i = 1, klon
2023            za = za + paire(i)/FLOAT(klon)
2024            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2025          ENDDO
2026          zx_t = zx_t/za*dtime
2027          PRINT*, "Precip=", zx_t
2028      ENDIF
2029      IF (zx_ajustq) THEN
2030          DO i = 1, klon
2031            z_apres(i) = 0.0
2032          ENDDO
2033          DO k = 1, klev
2034            DO i = 1, klon
2035              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2036     .            *(paprs(i,k)-paprs(i,k+1))/RG
2037            ENDDO
2038          ENDDO
2039          DO i = 1, klon
2040            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2041     .          /z_apres(i)
2042          ENDDO
2043          DO k = 1, klev
2044            DO i = 1, klon
2045              IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2046     .            z_factor(i).LT.(1.0-1.0E-08)) THEN
2047                  q_seri(i,k) = q_seri(i,k) * z_factor(i)
2048              ENDIF
2049            ENDDO
2050          ENDDO
2051      ENDIF
2052      zx_ajustq=.FALSE.
2053c
2054      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2055c
2056          IF (iflag_con .LT. 2 .AND.  iflag_con .GT. 4 ) THEN
2057              PRINT*, 'Pour l instant, seul conflx fonctionne ',
2058     $            'avec traceurs', iflag_con
2059              PRINT*,' Mettre iflag_con',
2060     $            ' = 2, 3 ou 4 dans run.def et repasser'
2061              CALL abort
2062              ENDIF
2063c
2064      ENDIF !--nqmax.GT.2
2065c
2066c Appeler l'ajustement sec
2067c
2068      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2069      DO k = 1, klev
2070      DO i = 1, klon
2071         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2072         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2073      ENDDO
2074      ENDDO
2075
2076c   RATQS
2077      if (iflag_con.eq.2) then
2078          flag_ratqs=0
2079      else
2080          flag_ratqs=1
2081      endif
2082      call calcratqs (flag_ratqs,
2083     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
2084     O           ,ratqs,zpt_conv)
2085c
2086c Appeler le processus de condensation a grande echelle
2087c et le processus de precipitation
2088c
2089      CALL fisrtilp_tr(dtime,paprs,pplay,
2090     .           t_seri, q_seri,ratqs,
2091     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2092     .           rain_lsc, snow_lsc,
2093     .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
2094     .           frac_impa, frac_nucl,
2095     .           prfl, psfl)
2096      WHERE (rain_lsc < 0) rain_lsc = 0.
2097      WHERE (snow_lsc < 0) snow_lsc = 0.
2098      DO k = 1, klev
2099      DO i = 1, klon
2100         t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2101         q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2102         ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2103         cldfra(i,k) = rneb(i,k)
2104         IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2105      ENDDO
2106      ENDDO
2107      IF (check) THEN
2108         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2109         PRINT*, "apresilp=", za
2110         zx_t = 0.0
2111         za = 0.0
2112         DO i = 1, klon
2113            za = za + paire(i)/FLOAT(klon)
2114            zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2115        ENDDO
2116         zx_t = zx_t/za*dtime
2117         PRINT*, "Precip=", zx_t
2118      ENDIF
2119c
2120c Nuages diagnostiques:
2121c
2122      IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
2123      CALL diagcld1(paprs,pplay,
2124     .             rain_con,snow_con,ibas_con,itop_con,
2125     .             diafra,dialiq)
2126      DO k = 1, klev
2127      DO i = 1, klon
2128      IF (diafra(i,k).GT.cldfra(i,k)) THEN
2129         cldliq(i,k) = dialiq(i,k)
2130         cldfra(i,k) = diafra(i,k)
2131      ENDIF
2132      ENDDO
2133      ENDDO
2134      ENDIF
2135c
2136c Nuages stratus artificiels:
2137c
2138      IF (ok_stratus) THEN
2139      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2140      DO k = 1, klev
2141      DO i = 1, klon
2142      IF (diafra(i,k).GT.cldfra(i,k)) THEN
2143         cldliq(i,k) = dialiq(i,k)
2144         cldfra(i,k) = diafra(i,k)
2145      ENDIF
2146      ENDDO
2147      ENDDO
2148      ENDIF
2149c
2150c Precipitation totale
2151c
2152      DO i = 1, klon
2153         rain_fall(i) = rain_con(i) + rain_lsc(i)
2154         snow_fall(i) = snow_con(i) + snow_lsc(i)
2155      ENDDO
2156c
2157c Calculer l'humidite relative pour diagnostique
2158c
2159      DO k = 1, klev
2160      DO i = 1, klon
2161         zx_t = t_seri(i,k)
2162         IF (thermcep) THEN
2163            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2164            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2165            zx_qs  = MIN(0.5,zx_qs)
2166            zcor   = 1./(1.-retv*zx_qs)
2167            zx_qs  = zx_qs*zcor
2168         ELSE
2169           IF (zx_t.LT.t_coup) THEN
2170              zx_qs = qsats(zx_t)/pplay(i,k)
2171           ELSE
2172              zx_qs = qsatl(zx_t)/pplay(i,k)
2173           ENDIF
2174         ENDIF
2175         zx_rh(i,k) = q_seri(i,k)/zx_qs
2176      ENDDO
2177      ENDDO
2178c
2179c Calculer les parametres optiques des nuages et quelques
2180c parametres pour diagnostiques:
2181c
2182      CALL nuage (paprs, pplay,
2183     .            t_seri, cldliq, cldfra, cldtau, cldemi,
2184     .            cldh, cldl, cldm, cldt, cldq)
2185c
2186c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2187c
2188      IF (MOD(itaprad,radpas).EQ.0) THEN
2189      DO i = 1, klon
2190         albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2191     .             + falbe(i,is_lic) * pctsrf(i,is_lic)
2192     .             + falbe(i,is_ter) * pctsrf(i,is_ter)
2193     .             + falbe(i,is_sic) * pctsrf(i,is_sic)
2194         albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2195     .               + falblw(i,is_lic) * pctsrf(i,is_lic)
2196     .               + falblw(i,is_ter) * pctsrf(i,is_ter)
2197     .               + falblw(i,is_sic) * pctsrf(i,is_sic)
2198      ENDDO
2199!      if (debut) then
2200!        albsol1 = albsol
2201!        albsollw1 = albsollw
2202!      endif
2203!      albsol = albsol1
2204!      albsollw = albsollw1
2205      CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2206     e            (dist, rmu0, fract, co2_ppm, solaire,
2207     e             paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2208     e             wo,
2209     e             cldfra, cldemi, cldtau,
2210     s             heat,heat0,cool,cool0,radsol,albpla,
2211     s             topsw,toplw,solsw,sollw,
2212     s             sollwdown,
2213     s             topsw0,toplw0,solsw0,sollw0)
2214      itaprad = 0
2215      ENDIF
2216      itaprad = itaprad + 1
2217c
2218c Ajouter la tendance des rayonnements (tous les pas)
2219c
2220      DO k = 1, klev
2221      DO i = 1, klon
2222         t_seri(i,k) = t_seri(i,k)
2223     .               + (heat(i,k)-cool(i,k)) * dtime/86400.
2224      ENDDO
2225      ENDDO
2226c
2227c Calculer l'hydrologie de la surface
2228c
2229c      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2230c     .            agesno, ftsol,fqsol,fsnow, ruis)
2231c
2232      DO i = 1, klon
2233         zxqsol(i) = 0.0
2234         zxsnow(i) = 0.0
2235      ENDDO
2236      DO nsrf = 1, nbsrf
2237      DO i = 1, klon
2238         zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2239         zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2240      ENDDO
2241      ENDDO
2242c
2243c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2244c
2245c$$$      DO nsrf = 1, nbsrf
2246c$$$      DO i = 1, klon
2247c$$$         IF (pctsrf(i,nsrf).LT.epsfra) THEN
2248c$$$            fqsol(i,nsrf) = zxqsol(i)
2249c$$$            fsnow(i,nsrf) = zxsnow(i)
2250c$$$         ENDIF
2251c$$$      ENDDO
2252c$$$      ENDDO
2253c
2254c Calculer le bilan du sol et la derive de temperature (couplage)
2255c
2256      DO i = 1, klon
2257         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2258      ENDDO
2259c
2260cmoddeblott(jan95)
2261c Appeler le programme de parametrisation de l'orographie
2262c a l'echelle sous-maille:
2263c
2264      IF (ok_orodr) THEN
2265c
2266c  selection des points pour lesquels le shema est actif:
2267        igwd=0
2268        DO i=1,klon
2269        itest(i)=0
2270c        IF ((zstd(i).gt.10.0)) THEN
2271        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2272          itest(i)=1
2273          igwd=igwd+1
2274          idx(igwd)=i
2275        ENDIF
2276        ENDDO
2277c        igwdim=MAX(1,igwd)
2278c
2279        CALL drag_noro(klon,klev,dtime,paprs,pplay,
2280     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
2281     e                   igwd,idx,itest,
2282     e                   t_seri, u_seri, v_seri,
2283     s                   zulow, zvlow, zustr, zvstr,
2284     s                   d_t_oro, d_u_oro, d_v_oro)
2285c
2286c  ajout des tendances
2287        DO k = 1, klev
2288        DO i = 1, klon
2289           t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2290           u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2291           v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2292        ENDDO
2293        ENDDO
2294c
2295      ENDIF ! fin de test sur ok_orodr
2296c
2297      IF (ok_orolf) THEN
2298c
2299c  selection des points pour lesquels le shema est actif:
2300        igwd=0
2301        DO i=1,klon
2302        itest(i)=0
2303        IF ((zpic(i)-zmea(i)).GT.100.) THEN
2304          itest(i)=1
2305          igwd=igwd+1
2306          idx(igwd)=i
2307        ENDIF
2308        ENDDO
2309c        igwdim=MAX(1,igwd)
2310c
2311        CALL lift_noro(klon,klev,dtime,paprs,pplay,
2312     e                   rlat,zmea,zstd,zpic,
2313     e                   itest,
2314     e                   t_seri, u_seri, v_seri,
2315     s                   zulow, zvlow, zustr, zvstr,
2316     s                   d_t_lif, d_u_lif, d_v_lif)
2317c
2318c  ajout des tendances
2319        DO k = 1, klev
2320        DO i = 1, klon
2321           t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2322           u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2323           v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2324        ENDDO
2325        ENDDO
2326c
2327      ENDIF ! fin de test sur ok_orolf
2328c
2329cAA
2330cAA Installation de l'interface online-offline pour traceurs
2331cAA
2332c====================================================================
2333c   Calcul  des tendances traceurs
2334c====================================================================
2335C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2336cKE43       des traceurs => il faut donc mettre des flags a .false.
2337      IF (iflag_con.GE.3) THEN
2338c           on ajoute les tendances calculees par KE43
2339c$$$ OM on onhibe la convection sur les traceurs
2340        DO iq=1, nqmax-2 ! Sandrine a -3 ???
2341c$$$ OM on inhibe la convection sur les traceur
2342c$$$        DO k = 1, nlev
2343c$$$        DO i = 1, klon
2344c$$$          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2345c$$$        ENDDO
2346c$$$        ENDDO
2347        WRITE(iqn,'(i2.2)') iq
2348        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2349        ENDDO
2350CMAF modif pour garder info du nombre de traceurs auxquels
2351C la physique s'applique
2352      ELSE
2353CMAF modif pour garder info du nombre de traceurs auxquels
2354C la physique s'applique
2355C
2356      call phytrac (rnpb,
2357     I                   debut,lafin,
2358     I                   nqmax-2,
2359     I                   nlon,nlev,dtime,
2360     I                   t,paprs,pplay,
2361     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2362     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2363     I                   frac_impa, frac_nucl,
2364     I                   rlon,presnivs,paire,pphis,
2365     O                   tr_seri)
2366      ENDIF
2367
2368      IF (offline) THEN
2369
2370         call phystokenc (
2371     I                   nlon,nlev,pdtphys,rlon,rlat,
2372     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2373     I                   ycoefh,yu1,yv1,ftsol,pctsrf,
2374     I                   frac_impa, frac_nucl,
2375     I                   pphis,paire,dtime,itap)
2376
2377
2378      ENDIF
2379
2380c
2381c Calculer le transport de l'eau et de l'energie (diagnostique)
2382c
2383      CALL transp (paprs,zxtsol,
2384     e                   t_seri, q_seri, u_seri, v_seri, zphi,
2385     s                   ve, vq, ue, uq)
2386c
2387c Accumuler les variables a stocker dans les fichiers histoire:
2388c
2389c
2390c
2391
2392      IF (ok_journe) THEN
2393c
2394      ndex2d = 0
2395      ndex3d = 0
2396c
2397c Champs 2D:
2398c
2399         zsto = dtime
2400         zout = dtime * FLOAT(ecrit_day)
2401         itau_w = itau_phy + itap
2402
2403         i = NINT(zout/zsto)
2404         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2405       CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2406         varname = 'phis'
2407         vartitle= 'Surface geop. height'
2408         varunits= '-'
2409c        call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2410c    .                                                    varunits)
2411c
2412         i = NINT(zout/zsto)
2413         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2414       CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2415         varname = 'aire'
2416         vartitle= 'Grid area'
2417         varunits= '-'
2418c        call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2419c    .                                                    varunits)
2420C
2421      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2422      CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2423c     call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2424c    .              'Surface Temperature','K')
2425c
2426C
2427      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2428      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2429      CALL histwrite(nid_day,"tter",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2430c     call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2431c    .              'Surface Temperature','K')
2432C
2433      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2434      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2435      CALL histwrite(nid_day,"tlic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2436c     call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2437c    .              'Surface Temperature','K')
2438C
2439      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2440      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2441      CALL histwrite(nid_day,"toce",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2442c     call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2443c    .              'Surface Temperature','K')
2444C
2445      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2446      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2447      CALL histwrite(nid_day,"tsic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2448c     call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2449c    .              'Surface Temperature','K')
2450C
2451      DO i = 1, klon
2452         zx_tmp_fi2d(i) = paprs(i,1)
2453      ENDDO
2454      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2455      CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2456c Essai writephys
2457      varname = 'psol'
2458      vartitle= 'pression au sol'
2459      varunits= 'hPa'
2460c     call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2461c    .                                                    varunits)
2462c
2463      DO i = 1, klon
2464         zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2465      ENDDO
2466      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2467      CALL histwrite(nid_day,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2468c     call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2469c    .              'Precipitation','mm/day')
2470
2471
2472c
2473      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2474      CALL histwrite(nid_day,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2475c     call writephy(fid_day,prof2d_av,'snow',snow_fall,
2476c    .              'Snow','mm/day')
2477c
2478      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2479      CALL histwrite(nid_day,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
2480     .               ndex2d)
2481c     call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2482c    .              'Snow cover','mm')
2483c
2484      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2485      CALL histwrite(nid_day,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2486c     call writephy(fid_day,prof2d_av,'evap',evap,
2487c    .              'Evaporation','mm/day')
2488c
2489      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2490      CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2491c     call writephy(fid_day,prof2d_av,'tops',topsw,
2492c    .              'Solar rad. at TOA','W/m2')
2493c
2494      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2495      CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2496c     call writephy(fid_day,prof2d_av,'topl',toplw,
2497c    .              'IR rad. at TOA','W/m2')
2498c
2499      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2500      CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2501c     call writephy(fid_day,prof2d_av,'sols',solsw,
2502c    .              'Solar rad. at surf.','W/m2')
2503c
2504      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2505      CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2506c     call writephy(fid_day,prof2d_av,'soll',sollw,
2507c    .              'IR rad. at surface','W/m2')
2508c
2509      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2510      CALL histwrite(nid_day,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
2511     .               ndex2d)
2512c     call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2513c    .              'Down. IR rad. at surface','W/m2')
2514c
2515      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2516      CALL histwrite(nid_day,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2517c     call writephy(fid_day,prof2d_av,'bils',bils,
2518c    .              'Surf. total heat flux','W/m2')
2519c
2520      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2521      CALL histwrite(nid_day,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2522c     call writephy(fid_day,prof2d_av,'sens',sens,
2523c    .              'Sensible heat flux','W/m2')
2524c
2525      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2526      CALL histwrite(nid_day,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2527c     call writephy(fid_day,prof2d_av,'fder',fder,
2528c    .              'Heat flux derivation','W/m2')
2529c
2530c
2531      DO nsrf = 1, nbsrf
2532C§§§
2533        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2534        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2535        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itau_w,
2536     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2537c       call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2538c    .                pctsrf( 1 : klon, nsrf),
2539c    .                'Fraction'//clnsurf(nsrf),'-')
2540C
2541        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2542        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2543        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itau_w,
2544     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2545c       call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2546c    .                ftsol( 1 : klon, nsrf),
2547c    .                'Surf. Temp'//clnsurf(nsrf),'K')
2548C
2549        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2550        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2551        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itau_w,
2552     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2553c       call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2554c    .                fluxt( 1 : klon, 1, nsrf),
2555c    .                'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2556
2557        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2558        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2559        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itau_w,
2560     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2561c       call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2562c    .                fluxlat( 1 : klon, nsrf),
2563c    .                'Latent heat flux '//clnsurf(nsrf),'W/m2')
2564C
2565        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2566        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2567        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itau_w,
2568     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2569c       call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2570c    .                fluxu( 1 : klon, 1, nsrf),
2571c    .                'Zonal wind stress '//clnsurf(nsrf),'Pa')
2572C     
2573        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2574        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2575        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itau_w,
2576     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2577c       call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2578c    .                fluxv( 1 : klon, 1, nsrf),
2579c    .                'Meridional wind stress '//clnsurf(nsrf),'Pa')
2580C
2581        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2582        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2583        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itau_w,
2584     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2585c       call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2586c    .                falbe( 1 : klon, nsrf),
2587c    .                'Albedo surf. SW'//clnsurf(nsrf),'-')
2588c       call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2589c    .                falblw( 1 : klon, nsrf),
2590c    .                'Albedo surf. LW'//clnsurf(nsrf),'-')
2591C
2592        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2593        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2594        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itau_w,
2595     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2596c       call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2597c    .                frugs( 1 : klon, nsrf),
2598c    .                'Rugosity '//clnsurf(nsrf),' - ')
2599C
2600      END DO 
2601C
2602c$$$      DO i = 1, klon
2603c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2604c$$$      ENDDO
2605c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2606c$$$      CALL histwrite(nid_day,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2607c
2608      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2609      CALL histwrite(nid_day,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2610c     call writephy(fid_day,prof2d_av,'cldl',cldl,
2611c    .              'Low-level cloudiness','-')
2612c
2613      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2614      CALL histwrite(nid_day,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2615c     call writephy(fid_day,prof2d_av,'cldm',cldm,
2616c    .              'Mid-level cloudiness','-')
2617c
2618      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2619      CALL histwrite(nid_day,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2620c     call writephy(fid_day,prof2d_av,'cldh',cldh,
2621c    .              'High-level cloudiness','-')
2622c
2623      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2624      CALL histwrite(nid_day,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2625c     call writephy(fid_day,prof2d_av,'cldt',cldt,
2626c    .              'Total cloudiness','-')
2627c
2628      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2629      CALL histwrite(nid_day,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2630c     call writephy(fid_day,prof2d_av,'cldq',cldq,
2631c    .              'Cloud liquid water path','-')
2632c
2633c Champs 3D:
2634c
2635      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2636      CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
2637     .                                   iim*jjmp1*klev,ndex3d)
2638c Essai writephys
2639      varname = 'temp'
2640      vartitle= 'temperature 3D'
2641      varunits= 'K'
2642c     call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2643c
2644      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2645      CALL histwrite(nid_day,"ovap",itau_w,zx_tmp_3d,
2646     .                                   iim*jjmp1*klev,ndex3d)
2647c     call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2648c    .              'Specific humidity','Kg/Kg')
2649c
2650      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2651      CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
2652     .                                   iim*jjmp1*klev,ndex3d)
2653c     call writephy(fid_day,prof3d_av,'geop',zphi,
2654c    .              'Geopotential height','m')
2655c
2656      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2657      CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
2658     .                                   iim*jjmp1*klev,ndex3d)
2659c     call writephy(fid_day,prof3d_av,'vitu',u_seri,
2660c    .              'Zonal wind','m/s')
2661c
2662      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2663      CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
2664     .                                   iim*jjmp1*klev,ndex3d)
2665c     call writephy(fid_day,prof3d_av,'vitv',v_seri,
2666c    .              'Meridional wind','m/s')
2667c
2668      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2669      CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
2670     .                                   iim*jjmp1*klev,ndex3d)
2671c     call writephy(fid_day,prof3d_av,'vitw',omega,
2672c    .              'Vertical wind','m/s')
2673c
2674      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2675      CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
2676     .                                   iim*jjmp1*klev,ndex3d)
2677c     call writephy(fid_day,prof3d_av,'pres',pplay,
2678c    .              'Air pressure','Pa')
2679
2680c
2681      if (ok_sync) then
2682c       call writephy_sync(fid_day)
2683        call histsync(nid_day)
2684      endif
2685      ENDIF
2686C
2687      IF (ok_mensuel) THEN
2688c
2689      ndex2d = 0
2690      ndex3d = 0
2691c
2692c Champs 2D:
2693c
2694         zsto = dtime
2695         zout = dtime * ecrit_mth
2696         itau_w = itau_phy + itap
2697
2698      i = NINT(zout/zsto)
2699      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2700      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2701C
2702      i = NINT(zout/zsto)
2703      CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2704      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2705
2706      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2707      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2708c
2709      DO i = 1, klon
2710         zx_tmp_fi2d(i) = paprs(i,1)
2711      ENDDO
2712      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2713      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2714c
2715      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2716      CALL histwrite(nid_mth,"qsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2717c
2718      DO i = 1, klon
2719         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2720      ENDDO
2721      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2722      CALL histwrite(nid_mth,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2723c
2724      DO i = 1, klon
2725         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2726      ENDDO
2727      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2728      CALL histwrite(nid_mth,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2729c
2730      DO i = 1, klon
2731         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2732      ENDDO
2733      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2734      CALL histwrite(nid_mth,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2735c
2736      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2737      CALL histwrite(nid_mth,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2738c
2739      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2740      CALL histwrite(nid_mth,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
2741     .               ndex2d)
2742c
2743      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2744      CALL histwrite(nid_mth,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2745c
2746      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2747      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2748c
2749      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2750      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2751c
2752      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2753      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2754c
2755      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2756      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2757c
2758      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2759      CALL histwrite(nid_mth,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
2760     .               ndex2d)
2761c
2762      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2763      CALL histwrite(nid_mth,"tops0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2764c
2765      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2766      CALL histwrite(nid_mth,"topl0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2767c
2768      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2769      CALL histwrite(nid_mth,"sols0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2770c
2771      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2772      CALL histwrite(nid_mth,"soll0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2773c
2774      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2775      CALL histwrite(nid_mth,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2776c
2777      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2778      CALL histwrite(nid_mth,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2779c
2780      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2781      CALL histwrite(nid_mth,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2782c
2783c
2784c      DO i = 1, klon
2785c         zx_tmp_fi2d(i) = fluxu(i,1)
2786c      ENDDO
2787c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2788c      CALL histwrite(nid_mth,"frtu",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2789c
2790c      DO i = 1, klon
2791c         zx_tmp_fi2d(i) = fluxv(i,1)
2792c      ENDDO
2793c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2794c      CALL histwrite(nid_mth,"frtv",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2795c
2796      DO nsrf = 1, nbsrf
2797C§§§
2798        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2799        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2800        CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itau_w,
2801     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2802C
2803        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2804        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2805        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itau_w,
2806     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2807C
2808        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2809        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2810        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itau_w,
2811     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2812C
2813        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2814        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2815        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itau_w,
2816     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2817C
2818        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2819        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2820        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itau_w,
2821     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2822C     
2823        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2824        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2825        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itau_w,
2826     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2827C
2828        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2829        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2830        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itau_w,
2831     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2832C
2833        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2834        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2835        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itau_w,
2836     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2837c
2838      zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2839      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2840      CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itau_w
2841     $    ,zx_tmp_2d,iim*jjmp1,ndex2d)
2842
2843      END DO 
2844c$$$      DO i = 1, klon
2845c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2846c$$$      ENDDO
2847c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2848c$$$      CALL histwrite(nid_mth,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2849c
2850      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2851      CALL histwrite(nid_mth,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2852      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2853      CALL histwrite(nid_mth,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2854c
2855      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2856      CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2857c
2858      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2859      CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2860c
2861      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2862      CALL histwrite(nid_mth,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2863c
2864      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2865      CALL histwrite(nid_mth,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2866c
2867      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2868      CALL histwrite(nid_mth,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2869c
2870      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2871      CALL histwrite(nid_mth,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2872c
2873      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2874      CALL histwrite(nid_mth,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2875c
2876      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2877      CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2878c
2879      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2880      CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2881c
2882      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2883      CALL histwrite(nid_mth,"uq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2884c
2885      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2886      CALL histwrite(nid_mth,"vq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2887cKE43
2888      IF (iflag_con .GE. 3) THEN ! sb
2889c
2890      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
2891      CALL histwrite(nid_mth,"cape",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2892c
2893      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
2894      CALL histwrite(nid_mth,"pbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2895c
2896      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
2897      CALL histwrite(nid_mth,"ptop",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2898c
2899      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
2900      CALL histwrite(nid_mth,"fbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2901c
2902c
2903      ENDIF
2904c34EK
2905c
2906c Champs 3D:
2907C
2908      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2909      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
2910     .                                   iim*jjmp1*klev,ndex3d)
2911c
2912      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2913      CALL histwrite(nid_mth,"ovap",itau_w,zx_tmp_3d,
2914     .                                   iim*jjmp1*klev,ndex3d)
2915c
2916      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2917      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
2918     .                                   iim*jjmp1*klev,ndex3d)
2919c
2920      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2921      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
2922     .                                   iim*jjmp1*klev,ndex3d)
2923c
2924      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2925      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
2926     .                                   iim*jjmp1*klev,ndex3d)
2927c
2928      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2929      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
2930     .                                   iim*jjmp1*klev,ndex3d)
2931c
2932      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2933      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
2934     .                                   iim*jjmp1*klev,ndex3d)
2935c
2936      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2937      CALL histwrite(nid_mth,"rneb",itau_w,zx_tmp_3d,
2938     .                                   iim*jjmp1*klev,ndex3d)
2939c
2940      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2941      CALL histwrite(nid_mth,"rhum",itau_w,zx_tmp_3d,
2942     .                                   iim*jjmp1*klev,ndex3d)
2943c
2944      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2945      CALL histwrite(nid_mth,"oliq",itau_w,zx_tmp_3d,
2946     .                                   iim*jjmp1*klev,ndex3d)
2947c
2948      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2949      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
2950     .                                   iim*jjmp1*klev,ndex3d)
2951c
2952      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2953      CALL histwrite(nid_mth,"dqdyn",itau_w,zx_tmp_3d,
2954     .                                   iim*jjmp1*klev,ndex3d)
2955c
2956      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2957      CALL histwrite(nid_mth,"dtcon",itau_w,zx_tmp_3d,
2958     .                                   iim*jjmp1*klev,ndex3d)
2959c
2960      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2961      CALL histwrite(nid_mth,"dqcon",itau_w,zx_tmp_3d,
2962     .                                   iim*jjmp1*klev,ndex3d)
2963c
2964      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2965      CALL histwrite(nid_mth,"dtlsc",itau_w,zx_tmp_3d,
2966     .                                   iim*jjmp1*klev,ndex3d)
2967c
2968      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2969      CALL histwrite(nid_mth,"dqlsc",itau_w,zx_tmp_3d,
2970     .                                   iim*jjmp1*klev,ndex3d)
2971c
2972      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2973      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
2974     .                                   iim*jjmp1*klev,ndex3d)
2975c
2976      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2977      CALL histwrite(nid_mth,"dqvdf",itau_w,zx_tmp_3d,
2978     .                                   iim*jjmp1*klev,ndex3d)
2979c
2980      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2981      CALL histwrite(nid_mth,"dteva",itau_w,zx_tmp_3d,
2982     .                                   iim*jjmp1*klev,ndex3d)
2983c
2984      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2985      CALL histwrite(nid_mth,"dqeva",itau_w,zx_tmp_3d,
2986     .                                   iim*jjmp1*klev,ndex3d)
2987c
2988      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
2989      CALL histwrite(nid_mth,"ptconv",itau_w,zx_tmp_3d,
2990     .                                   iim*(jjmp1)*klev,ndex3d)
2991c
2992      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
2993      CALL histwrite(nid_mth,"ratqs",itau_w,zx_tmp_3d,
2994     .                                   iim*(jjmp1)*klev,ndex3d)
2995c
2996      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
2997      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
2998     .                                   iim*jjmp1*klev,ndex3d)
2999c
3000      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
3001      CALL histwrite(nid_mth,"dqajs",itau_w,zx_tmp_3d,
3002     .                                   iim*jjmp1*klev,ndex3d)
3003c
3004      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
3005      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
3006     .                                   iim*jjmp1*klev,ndex3d)
3007c
3008      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
3009      CALL histwrite(nid_mth,"dtsw0",itau_w,zx_tmp_3d,
3010     .                                   iim*jjmp1*klev,ndex3d)
3011c
3012      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3013      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
3014     .                                   iim*jjmp1*klev,ndex3d)
3015c
3016      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3017      CALL histwrite(nid_mth,"dtlw0",itau_w,zx_tmp_3d,
3018     .                                   iim*jjmp1*klev,ndex3d)
3019c
3020      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3021      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
3022     .                                   iim*jjmp1*klev,ndex3d)
3023c
3024      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3025      CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
3026     .                                   iim*jjmp1*klev,ndex3d)
3027c
3028      IF (ok_orodr) THEN
3029      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3030      CALL histwrite(nid_mth,"duoro",itau_w,zx_tmp_3d,
3031     .                                   iim*jjmp1*klev,ndex3d)
3032c
3033      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3034      CALL histwrite(nid_mth,"dvoro",itau_w,zx_tmp_3d,
3035     .                                   iim*jjmp1*klev,ndex3d)
3036c
3037      ENDIF
3038C
3039      IF (ok_orolf) THEN
3040      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3041      CALL histwrite(nid_mth,"dulif",itau_w,zx_tmp_3d,
3042     .                                   iim*jjmp1*klev,ndex3d)
3043c
3044      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3045      CALL histwrite(nid_mth,"dvlif",itau_w,zx_tmp_3d,
3046     .                                   iim*jjmp1*klev,ndex3d)
3047      ENDIF
3048C
3049      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3050      CALL histwrite(nid_mth,"ozone",itau_w,zx_tmp_3d,
3051     .                                   iim*jjmp1*klev,ndex3d)
3052c
3053      IF (nqmax.GE.3) THEN
3054      DO iq=1,nqmax-2
3055      IF (iq.LE.99) THEN
3056         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3057         WRITE(str2,'(i2.2)') iq
3058         CALL histwrite(nid_mth,"trac"//str2,itau_w,zx_tmp_3d,
3059     .                                   iim*jjmp1*klev,ndex3d)
3060      ELSE
3061         PRINT*, "Trop de traceurs"
3062         CALL abort
3063      ENDIF
3064      ENDDO
3065      ENDIF
3066cKE43
3067      IF (iflag_con.GE.3) THEN ! (sb)
3068c
3069      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3070      CALL histwrite(nid_mth,"upwd",itau_w,zx_tmp_3d,
3071     .                                   iim*jjmp1*klev,ndex3d)
3072c
3073      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3074      CALL histwrite(nid_mth,"dnwd",itau_w,zx_tmp_3d,
3075     .                                   iim*jjmp1*klev,ndex3d)
3076c
3077      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3078      CALL histwrite(nid_mth,"dnwd0",itau_w,zx_tmp_3d,
3079     .                                   iim*jjmp1*klev,ndex3d)
3080c
3081      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3082      CALL histwrite(nid_mth,"Ma",itau_w,zx_tmp_3d,
3083     .                                   iim*jjmp1*klev,ndex3d)
3084c
3085c
3086      ENDIF
3087c34EK
3088c
3089      if (ok_sync) then
3090        call histsync(nid_mth)
3091      endif
3092      ENDIF
3093c
3094      IF (ok_instan) THEN
3095c
3096      ndex2d = 0
3097      ndex3d = 0
3098c
3099c Champs 2D:
3100c
3101         zsto = dtime * ecrit_ins
3102         zout = dtime * ecrit_ins
3103         itau_w = itau_phy + itap
3104
3105         i = NINT(zout/zsto)
3106      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3107      CALL histwrite(nid_ins,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3108c
3109         i = NINT(zout/zsto)
3110      CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3111      CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3112
3113      DO i = 1, klon
3114         zx_tmp_fi2d(i) = paprs(i,1)
3115      ENDDO
3116      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3117      CALL histwrite(nid_ins,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3118c
3119      DO i = 1, klon
3120         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3121      ENDDO
3122      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3123      CALL histwrite(nid_ins,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3124c
3125      DO i = 1, klon
3126         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3127      ENDDO
3128      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3129      CALL histwrite(nid_ins,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3130c
3131      DO i = 1, klon
3132         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3133      ENDDO
3134      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3135      CALL histwrite(nid_ins,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3136
3137      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3138      CALL histwrite(nid_ins,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3139c
3140      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3141      CALL histwrite(nid_ins,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3142
3143c
3144      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3145      CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3146c
3147      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3148      CALL histwrite(nid_ins,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3149c
3150      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3151      CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3152c
3153      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3154      CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3155c
3156      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3157      CALL histwrite(nid_ins,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
3158     .                ndex2d)
3159c
3160      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3161      CALL histwrite(nid_ins,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3162c
3163      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3164      CALL histwrite(nid_ins,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3165c
3166      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3167      CALL histwrite(nid_ins,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3168c
3169      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3170      CALL histwrite(nid_ins,"dtsvdfo",itau_w,zx_tmp_2d,iim*jjmp1,
3171     .               ndex2d)
3172c
3173      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3174      CALL histwrite(nid_ins,"dtsvdft",itau_w,zx_tmp_2d,iim*jjmp1,
3175     .               ndex2d)
3176c
3177      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3178      CALL histwrite(nid_ins,"dtsvdfg",itau_w,zx_tmp_2d,iim*jjmp1,
3179     .               ndex2d)
3180c
3181      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3182      CALL histwrite(nid_ins,"dtsvdfi",itau_w,zx_tmp_2d,iim*jjmp1,
3183     .               ndex2d)
3184
3185      DO nsrf = 1, nbsrf
3186C§§§
3187        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3188        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3189        CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itau_w,
3190     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3191C
3192        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3193        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3194        CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itau_w,
3195     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3196C
3197        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3198        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3199        CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itau_w,
3200     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3201C
3202        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3203        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3204        CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itau_w,
3205     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3206C
3207        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3208        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3209        CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itau_w,
3210     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3211C     
3212        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3213        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3214        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itau_w,
3215     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3216C
3217        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3218        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3219        CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itau_w,
3220     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3221C
3222        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3223        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3224        CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itau_w,
3225     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3226C
3227      END DO 
3228      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3229      CALL histwrite(nid_ins,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3230      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3231      CALL histwrite(nid_ins,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3232c
3233      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3234      CALL histwrite(nid_ins,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
3235     .               ndex2d)
3236c
3237      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3238      CALL histwrite(nid_ins,"rugs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3239c
3240c Champs 3D:
3241c
3242      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3243      CALL histwrite(nid_ins,"temp",itau_w,zx_tmp_3d,
3244     .                                   iim*jjmp1*klev,ndex3d)
3245c
3246      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3247      CALL histwrite(nid_ins,"vitu",itau_w,zx_tmp_3d,
3248     .                                   iim*jjmp1*klev,ndex3d)
3249c
3250      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3251      CALL histwrite(nid_ins,"vitv",itau_w,zx_tmp_3d,
3252     .                                   iim*jjmp1*klev,ndex3d)
3253c
3254      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3255      CALL histwrite(nid_ins,"geop",itau_w,zx_tmp_3d,
3256     .                                   iim*jjmp1*klev,ndex3d)
3257c
3258      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3259      CALL histwrite(nid_ins,"pres",itau_w,zx_tmp_3d,
3260     .                                   iim*jjmp1*klev,ndex3d)
3261c
3262      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3263      CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
3264     .                                   iim*jjmp1*klev,ndex3d)
3265c
3266      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3267      CALL histwrite(nid_ins,"dqvdf",itau_w,zx_tmp_3d,
3268     .                                   iim*jjmp1*klev,ndex3d)
3269
3270c
3271      if (ok_sync) then
3272        call histsync(nid_ins)
3273      endif
3274      ENDIF
3275c
3276c
3277c Ecrire la bande regionale (binaire grads)
3278      IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3279         CALL ecriregs(84,zxtsol)
3280         CALL ecriregs(84,paprs(1,1))
3281         CALL ecriregs(84,topsw)
3282         CALL ecriregs(84,toplw)
3283         CALL ecriregs(84,solsw)
3284         CALL ecriregs(84,sollw)
3285         CALL ecriregs(84,rain_fall)
3286         CALL ecriregs(84,snow_fall)
3287         CALL ecriregs(84,evap)
3288         CALL ecriregs(84,sens)
3289         CALL ecriregs(84,bils)
3290         CALL ecriregs(84,pctsrf(1,is_sic))
3291         CALL ecriregs(84,zxfluxu(1,1))
3292         CALL ecriregs(84,zxfluxv(1,1))
3293         CALL ecriregs(84,ue)
3294         CALL ecriregs(84,ve)
3295         CALL ecriregs(84,uq)
3296         CALL ecriregs(84,vq)
3297c
3298         CALL ecrirega(84,u_seri)
3299         CALL ecrirega(84,v_seri)
3300         CALL ecrirega(84,omega)
3301         CALL ecrirega(84,t_seri)
3302         CALL ecrirega(84,zphi)
3303         CALL ecrirega(84,q_seri)
3304         CALL ecrirega(84,cldfra)
3305         CALL ecrirega(84,cldliq)
3306         CALL ecrirega(84,pplay)
3307
3308
3309cc         CALL ecrirega(84,d_t_dyn)
3310cc         CALL ecrirega(84,d_q_dyn)
3311cc         CALL ecrirega(84,heat)
3312cc         CALL ecrirega(84,cool)
3313cc         CALL ecrirega(84,d_t_con)
3314cc         CALL ecrirega(84,d_q_con)
3315cc         CALL ecrirega(84,d_t_lsc)
3316cc         CALL ecrirega(84,d_q_lsc)
3317      ENDIF
3318c
3319c Convertir les incrementations en tendances
3320c
3321      DO k = 1, klev
3322      DO i = 1, klon
3323         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3324         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3325         d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3326         d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3327         d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3328      ENDDO
3329      ENDDO
3330c
3331      IF (nqmax.GE.3) THEN
3332      DO iq = 3, nqmax
3333      DO  k = 1, klev
3334      DO  i = 1, klon
3335         d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3336      ENDDO
3337      ENDDO
3338      ENDDO
3339      ENDIF
3340c
3341c Sauvegarder les valeurs de t et q a la fin de la physique:
3342c
3343      DO k = 1, klev
3344      DO i = 1, klon
3345         t_ancien(i,k) = t_seri(i,k)
3346         q_ancien(i,k) = q_seri(i,k)
3347      ENDDO
3348      ENDDO
3349c
3350c====================================================================
3351c Si c'est la fin, il faut conserver l'etat de redemarrage
3352c====================================================================
3353c
3354      IF (lafin) THEN
3355         itau_phy = itau_phy + itap
3356ccc         IF (ok_oasis) CALL quitcpl
3357         CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3358     .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3359     .      falbe, fevap, rain_fall, snow_fall,
3360     .      solsw, sollwdown,dlw,
3361     .      radsol,frugs,agesno,
3362     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3363     .      t_ancien, q_ancien)
3364      ENDIF
3365
3366      RETURN
3367      END
3368      FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3369      IMPLICIT none
3370c
3371c Calculer et imprimer l'eau totale. A utiliser pour verifier
3372c la conservation de l'eau
3373c
3374#include "YOMCST.h"
3375      INTEGER klon,klev
3376      REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3377      REAL aire(klon)
3378      REAL qtotal, zx, qcheck
3379      INTEGER i, k
3380c
3381      zx = 0.0
3382      DO i = 1, klon
3383         zx = zx + aire(i)
3384      ENDDO
3385      qtotal = 0.0
3386      DO k = 1, klev
3387      DO i = 1, klon
3388         qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3389     .                     *(paprs(i,k)-paprs(i,k+1))/RG
3390      ENDDO
3391      ENDDO
3392c
3393      qcheck = qtotal/zx
3394c
3395      RETURN
3396      END
3397      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3398      IMPLICIT none
3399c
3400c Tranformer une variable de la grille physique a
3401c la grille d'ecriture
3402c
3403      INTEGER nfield,nlon,iim,jjmp1, jjm
3404      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3405c
3406      INTEGER i, n, ig
3407c
3408      jjm = jjmp1 - 1
3409      DO n = 1, nfield
3410         DO i=1,iim
3411            ecrit(i,n) = fi(1,n)
3412            ecrit(i+jjm*iim,n) = fi(nlon,n)
3413         ENDDO
3414         DO ig = 1, nlon - 2
3415           ecrit(iim+ig,n) = fi(1+ig,n)
3416         ENDDO
3417      ENDDO
3418      RETURN
3419      END
3420
Note: See TracBrowser for help on using the repository browser.