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

Last change on this file since 304 was 304, checked in by lmdzadmin, 23 years ago

Probleme de flag_ratqs en cas d'utilisation de KE FH
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 119.3 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
362      INTEGER idayvrai
363      SAVE idayvrai
364c
365      INTEGER lmt_pas
366      SAVE lmt_pas                ! frequence de mise a jour
367      REAL pctsrf(klon,nbsrf)
368      SAVE pctsrf                 ! sous-fraction du sol
369      REAL albsol(klon)
370      SAVE albsol                 ! albedo du sol total
371      REAL albsollw(klon)
372      SAVE albsollw                 ! albedo du sol total
373      REAL albsol1(klon)
374      SAVE albsol1                 ! albedo du sol total
375      REAL albsollw1(klon)
376      SAVE albsollw1                 ! albedo du sol total
377
378      REAL wo(klon,klev)
379      SAVE wo                     ! ozone
380c======================================================================
381c
382c Declaration des procedures appelees
383c
384      EXTERNAL angle     ! calculer angle zenithal du soleil
385      EXTERNAL alboc     ! calculer l'albedo sur ocean
386      EXTERNAL albsno    ! calculer albedo sur neige
387      EXTERNAL ajsec     ! ajustement sec
388      EXTERNAL clmain    ! couche limite
389      EXTERNAL condsurf  ! lire les conditions aux limites
390      EXTERNAL conlmd    ! convection (schema LMD)
391cKE43
392      EXTERNAL conema  ! convect4.3
393      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
394cAA
395      EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
396c                          ! stockage des coefficients necessaires au
397c                          ! lessivage OFF-LINE et ON-LINE
398cAA
399      EXTERNAL hgardfou  ! verifier les temperatures
400      EXTERNAL nuage     ! calculer les proprietes radiatives
401      EXTERNAL o3cm      ! initialiser l'ozone
402      EXTERNAL orbite    ! calculer l'orbite terrestre
403      EXTERNAL ozonecm   ! prescrire l'ozone
404      EXTERNAL phyetat0  ! lire l'etat initial de la physique
405      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
406      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
407      EXTERNAL suphec    ! initialiser certaines constantes
408      EXTERNAL transp    ! transport total de l'eau et de l'energie
409      EXTERNAL ecribina  ! ecrire le fichier binaire global
410      EXTERNAL ecribins  ! ecrire le fichier binaire global
411      EXTERNAL ecrirega  ! ecrire le fichier binaire regional
412      EXTERNAL ecriregs  ! ecrire le fichier binaire regional
413c
414c Variables locales
415c
416      REAL dialiq(klon,klev)  ! eau liquide nuageuse
417      REAL diafra(klon,klev)  ! fraction nuageuse
418      REAL cldliq(klon,klev)  ! eau liquide nuageuse
419      REAL cldfra(klon,klev)  ! fraction nuageuse
420      REAL cldtau(klon,klev)  ! epaisseur optique
421      REAL cldemi(klon,klev)  ! emissivite infrarouge
422c
423C§§§ PB
424      REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
425      REAL fluxt(klon,klev, nbsrf)   ! flux turbulent de chaleur
426      REAL fluxu(klon,klev, nbsrf)   ! flux turbulent de vitesse u
427      REAL fluxv(klon,klev, nbsrf)   ! flux turbulent de vitesse v
428c
429      REAL zxfluxt(klon, klev)
430      REAL zxfluxq(klon, klev)
431      REAL zxfluxu(klon, klev)
432      REAL zxfluxv(klon, klev)
433C§§§
434      REAL heat(klon,klev)    ! chauffage solaire
435      REAL heat0(klon,klev)   ! chauffage solaire ciel clair
436      REAL cool(klon,klev)    ! refroidissement infrarouge
437      REAL cool0(klon,klev)   ! refroidissement infrarouge ciel clair
438      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
439      real sollwdown(klon)    ! downward LW flux at surface
440      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
441      REAL albpla(klon)
442c Le rayonnement n'est pas calcule tous les pas, il faut donc
443c                      sauvegarder les sorties du rayonnement
444      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
445      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
446      INTEGER itaprad
447      SAVE itaprad
448c
449      REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
450      REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
451c
452      REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
453      REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
454c
455      REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
456c
457      REAL dist, rmu0(klon), fract(klon)
458      REAL zdtime, zlongi
459c
460      CHARACTER*2 str2
461      CHARACTER*2 iqn
462c
463      REAL qcheck
464      REAL z_avant(klon), z_apres(klon), z_factor(klon)
465      LOGICAL zx_ajustq
466c
467      REAL za, zb
468      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
469      INTEGER i, k, iq, nsrf, ll
470      REAL t_coup
471      PARAMETER (t_coup=234.0)
472c
473      REAL zphi(klon,klev)
474      REAL zx_tmp_x(iim), zx_tmp_yjjmp1
475      REAL zx_relief(iim,jjmp1)
476      REAL zx_aire(iim,jjmp1)
477cKE43
478c Variables locales pour la convection de K. Emanuel (sb):
479c
480      REAL upwd(klon,klev)      ! saturated updraft mass flux
481      REAL dnwd(klon,klev)      ! saturated downdraft mass flux
482      REAL dnwd0(klon,klev)     ! unsaturated downdraft mass flux
483      REAL tvp(klon,klev)       ! virtual temp of lifted parcel
484      REAL cape(klon)           ! CAPE
485      SAVE cape
486      REAL pbase(klon)          ! cloud base pressure
487      SAVE pbase
488      REAL bbase(klon)          ! cloud base buoyancy
489      SAVE bbase
490      REAL rflag(klon)          ! flag fonctionnement de convect
491      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
492c -- convect43:
493      INTEGER ntra              ! nb traceurs pour convect4.3
494      REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
495      REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
496      REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
497      REAL dplcldt(klon), dplcldr(klon)
498c?     .     condm_con(klon,klev),conda_con(klon,klev),
499c?     .     mr_con(klon,klev),ep_con(klon,klev)
500c?     .    ,sadiab(klon,klev),wadiab(klon,klev)
501c --
502c34EK
503c
504c Variables du changement
505c
506c con: convection
507c lsc: condensation a grande echelle (Large-Scale-Condensation)
508c ajs: ajustement sec
509c eva: evaporation de l'eau liquide nuageuse
510c vdf: couche limite (Vertical DiFfusion)
511      REAL d_t_con(klon,klev),d_q_con(klon,klev)
512      REAL d_u_con(klon,klev),d_v_con(klon,klev)
513      REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
514      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
515      REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
516      REAL rneb(klon,klev)
517c
518      REAL pmfu(klon,klev), pmfd(klon,klev)
519      REAL pen_u(klon,klev), pen_d(klon,klev)
520      REAL pde_u(klon,klev), pde_d(klon,klev)
521      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
522      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
523      REAL prfl(klon,klev+1), psfl(klon,klev+1)
524c
525      INTEGER ibas_con(klon), itop_con(klon)
526      REAL rain_con(klon), rain_lsc(klon)
527      REAL snow_con(klon), snow_lsc(klon)
528      REAL d_ts(klon,nbsrf)
529c
530      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
531      REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
532c
533      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
534      REAL d_t_oro(klon,klev)
535      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
536      REAL d_t_lif(klon,klev)
537
538      REAL ratqs(klon,klev)
539      integer flag_ratqs
540      real zpt_conv(klon,klev)
541
542c
543c Variables liees a l'ecriture de la bande histoire physique
544c
545      INTEGER ecrit_mth
546      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
547c
548      INTEGER ecrit_day
549      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
550c
551      INTEGER ecrit_ins
552      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
553c
554      INTEGER ecrit_reg
555      SAVE ecrit_reg   ! frequence d'ecriture
556c
557c
558c
559c Variables locales pour effectuer les appels en serie
560c
561      REAL t_seri(klon,klev), q_seri(klon,klev)
562      REAL ql_seri(klon,klev)
563      REAL u_seri(klon,klev), v_seri(klon,klev)
564c
565      REAL tr_seri(klon,klev,nbtr)
566      REAL d_tr(klon,klev,nbtr)
567
568      REAL zx_rh(klon,klev)
569
570      INTEGER        length
571      PARAMETER    ( length = 100 )
572      REAL tabcntr0( length       )
573c
574      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
575      REAL zx_tmp_fi2d(klon)
576      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
577      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
578c
579      INTEGER nid_day, nid_mth, nid_ins
580      SAVE nid_day, nid_mth, nid_ins
581c
582      INTEGER nhori, nvert
583      REAL zsto, zout
584      real zjulian
585      save zjulian
586
587      character*20 modname
588      character*80 abort_message
589      logical ok_sync
590      real date0
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/48.)  ! a chaque pas de temps
737         ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
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
763         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
764         zjulian = zjulian + day_ini
765
766c
767      IF (ok_journe) THEN
768c
769         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
770         zjulian = zjulian + day_ini
771c
772         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
773         DO i = 1, iim
774            zx_lon(i,1) = rlon(i+1)
775            zx_lon(i,jjmp1) = rlon(i+1)
776         ENDDO
777         DO ll=1,klev
778            znivsig(ll)=float(ll)
779         ENDDO
780         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
781         CALL histbeg("histday", iim,zx_lon, jjmp1,zx_lat,
782     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
783     .                 nhori, nid_day)
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         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1005         zjulian = zjulian + day_ini
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", iim,zx_lon, jjmp1,zx_lat,
1017     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
1018     .                 nhori, nid_mth)
1019         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
1020     .                 klev, presnivs, nvert)
1021c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
1022c    .              klev, znivsig, nvert)
1023c
1024         zsto = dtime
1025         zout = dtime * ecrit_mth
1026c
1027         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
1028     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1029     .                "once",  zsto,zout)
1030c
1031         CALL histdef(nid_mth, "aire", "Grid area", "-",
1032     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1033     .                "once",  zsto,zout)
1034c
1035c Champs 2D:
1036c
1037         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
1038     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1039     .                "ave(X)", zsto,zout)
1040c
1041         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
1042     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1043     .                "ave(X)", zsto,zout)
1044c
1045         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
1046     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1047     .                "ave(X)", zsto,zout)
1048c
1049         CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
1050     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1051     .                "ave(X)", zsto,zout)
1052c
1053         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
1054     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1055     .                "ave(X)", zsto,zout)
1056c
1057         CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
1058     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1059     .                "ave(X)", zsto,zout)
1060c
1061         CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
1062     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1063     .                "ave(X)", zsto,zout)
1064c
1065         CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
1066     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1067     .                "ave(X)", zsto,zout)
1068c
1069         CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
1070     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1071     .                "ave(X)", zsto,zout)
1072c
1073         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
1074     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1075     .                "ave(X)", zsto,zout)
1076c
1077         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
1078     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1079     .                "ave(X)", zsto,zout)
1080c
1081         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
1082     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1083     .                "ave(X)", zsto,zout)
1084c
1085         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
1086     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1087     .                "ave(X)", zsto,zout)
1088c
1089         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
1090     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1091     .                "ave(X)", zsto,zout)
1092c
1093         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
1094     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1095     .                "ave(X)", zsto,zout)
1096c
1097         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
1098     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1099     .                "ave(X)", zsto,zout)
1100c
1101         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
1102     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1103     .                "ave(X)", zsto,zout)
1104c
1105         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
1106     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1107     .                "ave(X)", zsto,zout)
1108c
1109         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
1110     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1111     .                "ave(X)", zsto,zout)
1112c
1113         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
1114     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1115     .                "ave(X)", zsto,zout)
1116c
1117         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
1118     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1119     .                "ave(X)", zsto,zout)
1120c
1121         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
1122     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1123     .                "ave(X)", zsto,zout)
1124c
1125         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
1126     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1127     .                "ave(X)", zsto,zout)
1128c
1129         DO nsrf = 1, nbsrf
1130C
1131           call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1132     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1133     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1134     $         "ave(X)", zsto,zout)
1135C
1136           call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
1137     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1138     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1139     $         "ave(X)", zsto,zout)
1140C
1141           call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1142     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
1143     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1144     $         "ave(X)", zsto,zout)
1145c
1146           call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1147     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1148     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1149     $         "ave(X)", zsto,zout)
1150C
1151           call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1152     $         "Zonal wind stress"//clnsurf(nsrf), "Pa", 
1153     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1154     $         "ave(X)", zsto,zout)
1155
1156           call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1157     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
1158     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1159     $         "ave(X)", zsto,zout)
1160c
1161           call histdef(nid_mth, "albe_"//clnsurf(nsrf),
1162     $         "Albedo surf. "//clnsurf(nsrf), "W/m2", 
1163     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1164     $         "ave(X)", zsto,zout)
1165c
1166           call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
1167     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1168     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1169     $         "ave(X)", zsto,zout)
1170c
1171         CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
1172     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1173     .                "ave(X)", zsto,zout)
1174
1175         END DO
1176C
1177         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1178     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1179     .                "ave(X)", zsto,zout)
1180c
1181         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1182     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1183     .                "ave(X)", zsto,zout)
1184         CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
1185     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1186     .                "ave(X)", zsto,zout)
1187c
1188         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1189     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1190     .                "ave(X)", zsto,zout)
1191c
1192         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1193     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1194     .                "ave(X)", zsto,zout)
1195c
1196         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1197     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1198     .                "ave(X)", zsto,zout)
1199c
1200         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1201     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1202     .                "ave(X)", zsto,zout)
1203c
1204         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1205     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1206     .                "ave(X)", zsto,zout)
1207c
1208         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1209     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1210     .                "ave(X)", zsto,zout)
1211c
1212         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1213     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1214     .                "ave(X)", zsto,zout)
1215c
1216         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1217     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1218     .                "ave(X)", zsto,zout)
1219c
1220         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1221     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1222     .                "ave(X)", zsto,zout)
1223c
1224         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1225     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1226     .                "ave(X)", zsto,zout)
1227c
1228         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1229     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1230     .                "ave(X)", zsto,zout)
1231cKE43
1232      IF (iflag_con .GE. 3) THEN ! sb
1233c
1234         CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
1235     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1236     .                "ave(X)", zsto,zout)
1237c
1238         CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
1239     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1240     .                "ave(X)", zsto,zout)
1241c
1242         CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
1243     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1244     .                "ave(X)", zsto,zout)
1245c
1246         CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
1247     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1248     .                "ave(X)", zsto,zout)
1249c
1250c
1251      ENDIF
1252c34EK
1253c
1254c Champs 3D:
1255c
1256         CALL histdef(nid_mth, "temp", "Air temperature", "K",
1257     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1258     .                "ave(X)", zsto,zout)
1259c
1260         CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1261     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1262     .                "ave(X)", zsto,zout)
1263c
1264         CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1265     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1266     .                "ave(X)", zsto,zout)
1267c
1268         CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1269     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1270     .                "ave(X)", zsto,zout)
1271c
1272         CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1273     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1274     .                "ave(X)", zsto,zout)
1275c
1276         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1277     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1278     .                "ave(X)", zsto,zout)
1279c
1280         CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1281     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1282     .                "ave(X)", zsto,zout)
1283c
1284         CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1285     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1286     .                "ave(X)", zsto,zout)
1287c
1288         CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1289     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1290     .                "ave(X)", zsto,zout)
1291c
1292         CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1293     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1294     .                "ave(X)", zsto,zout)
1295c
1296         CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1297     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1298     .                "ave(X)", zsto,zout)
1299c
1300         CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1301     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1302     .                "ave(X)", zsto,zout)
1303c
1304         CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1305     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1306     .                "ave(X)", zsto,zout)
1307c
1308         CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1309     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1310     .                "ave(X)", zsto,zout)
1311c
1312         CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1313     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1314     .                "ave(X)", zsto,zout)
1315c
1316         CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1317     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1318     .                "ave(X)", zsto,zout)
1319c
1320         CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1321     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1322     .                "ave(X)", zsto,zout)
1323c
1324         CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1325     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1326     .                "ave(X)", zsto,zout)
1327c
1328         CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1329     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1330     .                "ave(X)", zsto,zout)
1331c
1332         CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1333     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1334     .                "ave(X)", zsto,zout)
1335
1336         CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
1337     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1338     .                "ave(X)", zsto,zout)
1339
1340         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1341     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1342     .                "ave(X)", zsto,zout)
1343
1344c
1345         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1346     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1347     .                "ave(X)", zsto,zout)
1348
1349         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1350     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1351     .                "ave(X)", zsto,zout)
1352c
1353         CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1354     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1355     .                "ave(X)", zsto,zout)
1356c
1357         CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1358     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1359     .                "ave(X)", zsto,zout)
1360c
1361         CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1362     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1363     .                "ave(X)", zsto,zout)
1364c
1365         CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1366     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1367     .                "ave(X)", zsto,zout)
1368c
1369         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1370     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1371     .                "ave(X)", zsto,zout)
1372c
1373         CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1374     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1375     .                "ave(X)", zsto,zout)
1376c
1377         IF (ok_orodr) THEN
1378         CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1379     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1380     .                "ave(X)", zsto,zout)
1381c
1382         CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1383     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1384     .                "ave(X)", zsto,zout)
1385c
1386         ENDIF
1387C
1388         IF (ok_orolf) THEN
1389         CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1390     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1391     .                "ave(X)", zsto,zout)
1392c
1393         CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1394     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1395     .                "ave(X)", zsto,zout)
1396         ENDIF
1397C
1398         CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1399     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1400     .                "ave(X)", zsto,zout)
1401c
1402         if (nqmax.GE.3) THEN
1403         DO iq=1,nqmax-2
1404         IF (iq.LE.99) THEN
1405         WRITE(str2,'(i2.2)') iq
1406         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1407     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1408     .                "ave(X)", zsto,zout)
1409         ELSE
1410         PRINT*, "Trop de traceurs"
1411         CALL abort
1412         ENDIF
1413         ENDDO
1414         ENDIF
1415c
1416cKE43
1417      IF (iflag_con.GE.3) THEN ! (sb)
1418c
1419         CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
1420     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1421     .                "ave(X)", zsto,zout)
1422c
1423         CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
1424     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1425     .                "ave(X)", zsto,zout)
1426c
1427         CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
1428     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1429     .                "ave(X)", zsto,zout)
1430c
1431         CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
1432     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1433     .                "ave(X)", zsto,zout)
1434c
1435c
1436      ENDIF
1437c34EK
1438         CALL histend(nid_mth)
1439c
1440         ndex2d = 0
1441         ndex3d = 0
1442c
1443      ENDIF ! fin de test sur ok_mensuel
1444c
1445c
1446      IF (ok_instan) THEN
1447c
1448         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1449         zjulian = zjulian + day_ini
1450c
1451         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1452         DO i = 1, iim
1453            zx_lon(i,1) = rlon(i+1)
1454            zx_lon(i,jjmp1) = rlon(i+1)
1455         ENDDO
1456         DO ll=1,klev
1457            znivsig(ll)=float(ll)
1458         ENDDO
1459         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1460         CALL histbeg("histins", iim,zx_lon, jjmp1,zx_lat,
1461     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
1462     .                 nhori, nid_ins)
1463         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1464     .                 klev, presnivs, nvert)
1465c        call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1466c    .              klev, znivsig, nvert)
1467c
1468c
1469         zsto = dtime * ecrit_ins
1470         zout = dtime * ecrit_ins
1471C
1472         CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1473     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1474     .                "once", zsto,zout)
1475c
1476         CALL histdef(nid_ins, "aire", "Grid area", "-",
1477     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1478     .                "once", zsto,zout)
1479c
1480c Champs 2D:
1481c
1482        CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1483     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1484     .                "inst(X)", zsto,zout)
1485c
1486        CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1487     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1488     .                "inst(X)", zsto,zout)
1489c
1490         CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
1491     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1492     .                "inst(X)", zsto,zout)
1493c
1494         CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
1495     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1496     .                "inst(X)", zsto,zout)
1497
1498        CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
1499     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1500     .                "inst(X)", zsto,zout)
1501c
1502         CALL histdef(nid_ins, "rain", "Precipitation", "mm/day",
1503     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1504     .                "inst(X)", zsto,zout)
1505c
1506         CALL histdef(nid_ins, "snow", "Snow fall", "mm/day",
1507     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1508     .                "inst(X)", zsto,zout)
1509c
1510         CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
1511     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1512     .                "inst(X)", zsto,zout)
1513c
1514         CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1515     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1516     .                "inst(X)", zsto,zout)
1517c
1518         CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1519     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1520     .                "inst(X)", zsto,zout)
1521c
1522         CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1523     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1524     .                "inst(X)", zsto,zout)
1525c
1526         CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1527     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1528     .                "inst(X)", zsto,zout)
1529c
1530         CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
1531     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1532     .                "inst(X)", zsto,zout)
1533c
1534         CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1535     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1536     .                "inst(X)", zsto,zout)
1537c
1538         CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1539     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1540     .                "inst(X)", zsto,zout)
1541c
1542         CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1543     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1544     .                "inst(X)", zsto,zout)
1545c
1546      CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1547     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1548     .                "inst(X)", zsto,zout)
1549c
1550      CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1551     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1552     .                "inst(X)", zsto,zout)
1553c
1554      CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1555     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1556     .                "inst(X)", zsto,zout)
1557c
1558      CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1559     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1560     .                "inst(X)", zsto,zout)
1561
1562         DO nsrf = 1, nbsrf
1563C
1564           call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1565     $         "Fraction"//clnsurf(nsrf), "W/m2", 
1566     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1567     $         "inst(X)", zsto,zout)
1568
1569           call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1570     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
1571     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1572     $         "inst(X)", zsto,zout)
1573c
1574           call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1575     $         "Surface Temperature"//clnsurf(nsrf), "W/m2", 
1576     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1577     $         "inst(X)", zsto,zout)
1578c
1579           call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1580     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1581     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1582     $         "inst(X)", zsto,zout)
1583C
1584           call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1585     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
1586     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1587     $         "inst(X)", zsto,zout)
1588
1589           call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1590     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
1591     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1592     $         "inst(X)", zsto,zout)
1593c
1594           call histdef(nid_ins, "albe_"//clnsurf(nsrf),
1595     $         "Albedo "//clnsurf(nsrf), "-", 
1596     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1597     $         "inst(X)", zsto,zout)
1598c
1599           call histdef(nid_ins, "rugs_"//clnsurf(nsrf),
1600     $         "rugosite "//clnsurf(nsrf), "-", 
1601     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1602     $         "inst(X)", zsto,zout)
1603C§§§
1604         END DO
1605         CALL histdef(nid_ins, "rugs", "rugosity", "-",
1606     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1607     .                "inst(X)", zsto,zout)
1608
1609c
1610         CALL histdef(nid_ins, "albs", "Surface albedo", "-",
1611     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1612     .                "inst(X)", zsto,zout)
1613         CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
1614     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1615     .                "inst(X)", zsto,zout)
1616c
1617c
1618c Champs 3D:
1619c
1620         CALL histdef(nid_ins, "temp", "Temperature", "K",
1621     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1622     .                "inst(X)", zsto,zout)
1623c
1624         CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1625     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1626     .                "inst(X)", zsto,zout)
1627c
1628         CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1629     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1630     .                "inst(X)", zsto,zout)
1631c
1632         CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1633     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1634     .                "inst(X)", zsto,zout)
1635c
1636         CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1637     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1638     .                "inst(X)", zsto,zout)
1639c
1640         CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1641     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1642     .                "inst(X)", zsto,zout)
1643c
1644         CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1645     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1646     .                "inst(X)", zsto,zout)
1647c
1648
1649         CALL histend(nid_ins)
1650c
1651         ndex2d = 0
1652         ndex3d = 0
1653c
1654      ENDIF
1655
1656c$$$PB Positionner date0 pour initialisation de ORCHIDEE
1657c$$$      date0 = zjulian
1658      date0 = day_ini
1659      WRITE(*,*) 'physiq date0 : ',date0
1660c
1661c
1662c
1663c Prescrire l'ozone dans l'atmosphere
1664c
1665c
1666cc         DO i = 1, klon
1667cc         DO k = 1, klev
1668cc            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1669cc         ENDDO
1670cc         ENDDO
1671c
1672c
1673      ENDIF
1674c
1675c   ****************     Fin  de   IF ( debut  )   ***************
1676c
1677c
1678c Mettre a zero des variables de sortie (pour securite)
1679c
1680      DO i = 1, klon
1681         d_ps(i) = 0.0
1682      ENDDO
1683      DO k = 1, klev
1684      DO i = 1, klon
1685         d_t(i,k) = 0.0
1686         d_u(i,k) = 0.0
1687         d_v(i,k) = 0.0
1688      ENDDO
1689      ENDDO
1690      DO iq = 1, nqmax
1691      DO k = 1, klev
1692      DO i = 1, klon
1693         d_qx(i,k,iq) = 0.0
1694      ENDDO
1695      ENDDO
1696      ENDDO
1697c
1698c Ne pas affecter les valeurs entrees de u, v, h, et q
1699c
1700      DO k = 1, klev
1701      DO i = 1, klon
1702         t_seri(i,k)  = t(i,k)
1703         u_seri(i,k)  = u(i,k)
1704         v_seri(i,k)  = v(i,k)
1705         q_seri(i,k)  = qx(i,k,ivap)
1706         ql_seri(i,k) = qx(i,k,iliq)
1707      ENDDO
1708      ENDDO
1709      IF (nqmax.GE.3) THEN
1710      DO iq = 3, nqmax
1711      DO  k = 1, klev
1712      DO  i = 1, klon
1713         tr_seri(i,k,iq-2) = qx(i,k,iq)
1714      ENDDO
1715      ENDDO
1716      ENDDO
1717      ELSE
1718      DO k = 1, klev
1719      DO i = 1, klon
1720         tr_seri(i,k,1) = 0.0
1721      ENDDO
1722      ENDDO
1723      ENDIF
1724c
1725c Diagnostiquer la tendance dynamique
1726c
1727      IF (ancien_ok) THEN
1728         DO k = 1, klev
1729         DO i = 1, klon
1730            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1731            d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1732         ENDDO
1733         ENDDO
1734      ELSE
1735         DO k = 1, klev
1736         DO i = 1, klon
1737            d_t_dyn(i,k) = 0.0
1738            d_q_dyn(i,k) = 0.0
1739         ENDDO
1740         ENDDO
1741         ancien_ok = .TRUE.
1742      ENDIF
1743c
1744c Ajouter le geopotentiel du sol:
1745c
1746      DO k = 1, klev
1747      DO i = 1, klon
1748         zphi(i,k) = pphi(i,k) + pphis(i)
1749      ENDDO
1750      ENDDO
1751c
1752c Verifier les temperatures
1753c
1754      CALL hgardfou(t_seri,ftsol,'debutphy')
1755c
1756c Incrementer le compteur de la physique
1757c
1758      itap   = itap + 1
1759      julien = MOD(NINT(xjour),360)
1760c
1761c Mettre en action les conditions aux limites (albedo, sst, etc.).
1762c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1763c
1764      IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1765         idayvrai = NINT(xjour)
1766         PRINT *,' PHYS cond  julien ',julien,idayvrai
1767         CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1768      ENDIF
1769c
1770c Re-evaporer l'eau liquide nuageuse
1771c
1772      DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
1773      DO i = 1, klon
1774         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1775         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1776         zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1777         zb = MAX(0.0,ql_seri(i,k))
1778         za = - MAX(0.0,ql_seri(i,k))
1779     .                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
1780         t_seri(i,k) = t_seri(i,k) + za
1781         q_seri(i,k) = q_seri(i,k) + zb
1782         ql_seri(i,k) = 0.0
1783         d_t_eva(i,k) = za
1784         d_q_eva(i,k) = zb
1785      ENDDO
1786      ENDDO
1787c
1788c Appeler la diffusion verticale (programme de couche limite)
1789c
1790      DO i = 1, klon
1791c       if (.not. ok_veget) then
1792c          frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
1793c       endif
1794c         frugs(i,is_lic) = rugoro(i)
1795c         frugs(i,is_oce) = rugmer(i)
1796c         frugs(i,is_sic) = 0.001
1797         zxrugs(i) = 0.0
1798      ENDDO
1799      DO nsrf = 1, nbsrf
1800      DO i = 1, klon
1801         frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1802      ENDDO
1803      ENDDO
1804      DO nsrf = 1, nbsrf
1805      DO i = 1, klon
1806            zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1807      ENDDO
1808      ENDDO
1809c
1810C calculs necessaires au calcul de l'albedo dans l'interface
1811c
1812      CALL orbite(FLOAT(julien),zlongi,dist)
1813      IF (cycle_diurne) THEN
1814        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1815        CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1816      ELSE
1817        rmu0 = -999.999
1818      ENDIF
1819
1820      fder = dlw
1821
1822      CALL clmain(dtime,itap,zjulian,pctsrf,
1823     e            t_seri,q_seri,u_seri,v_seri,
1824     e            julien, rmu0,
1825     e            ok_veget, ocean, npas, nexca, ftsol,
1826     $            soil_model,ftsoil,
1827     $            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,falblw,
1828     $            fluxlat,
1829     e            rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
1830     e            rlon, rlat, cufi, cvfi, frugs,
1831     e            debut, lafin, agesno,rugoro ,
1832     s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1833     s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
1834     s            dsens, devap,
1835     s            ycoefh,yu1,yv1)
1836
1837c
1838C§§§ PB
1839C§§§ Incrementation des flux
1840C§§
1841      zxfluxt=0.
1842      zxfluxq=0.
1843      zxfluxu=0.
1844      zxfluxv=0.
1845      DO nsrf = 1, nbsrf
1846        DO k = 1, klev
1847          DO i = 1, klon
1848            zxfluxt(i,k) = zxfluxt(i,k) +
1849     $          fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1850            zxfluxq(i,k) = zxfluxq(i,k) +
1851     $          fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1852            zxfluxu(i,k) = zxfluxu(i,k) +
1853     $          fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1854            zxfluxv(i,k) = zxfluxv(i,k) +
1855     $          fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1856          END DO
1857        END DO
1858      END DO
1859      DO i = 1, klon
1860         sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1861c         evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1862         evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1863         fder(i) = dlw(i) + dsens(i) + devap(i)
1864      ENDDO
1865
1866
1867      DO k = 1, klev
1868      DO i = 1, klon
1869         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1870         q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1871         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1872         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1873      ENDDO
1874      ENDDO
1875c
1876c Incrementer la temperature du sol
1877c
1878      DO i = 1, klon
1879         zxtsol(i) = 0.0
1880         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1881     $       pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)
1882     $       THEN
1883             WRITE(*,*) 'physiq : pb sous surface au point ', i,
1884     $           pctsrf(i, 1 : nbsrf)
1885         ENDIF
1886      ENDDO
1887      DO nsrf = 1, nbsrf
1888      DO i = 1, klon
1889c$$$        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1890            ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1891            zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1892c$$$        ENDIF
1893      ENDDO
1894      ENDDO
1895
1896c
1897c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1898c
1899      DO nsrf = 1, nbsrf
1900        DO i = 1, klon
1901          IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
1902        ENDDO
1903      ENDDO
1904
1905c
1906c Calculer la derive du flux infrarouge
1907c
1908c$$$      DO nsrf = 1, nbsrf
1909      DO i = 1, klon
1910c$$$        IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1911            dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3
1912c$$$     .          *(ftsol(i,nsrf)-zxtsol(i))
1913c$$$     .          *pctsrf(i,nsrf)
1914c$$$        ENDIF
1915c$$$      ENDDO
1916      ENDDO
1917c
1918c Appeler la convection (au choix)
1919c
1920      DO k = 1, klev
1921      DO i = 1, klon
1922         conv_q(i,k) = d_q_dyn(i,k)
1923     .               + d_q_vdf(i,k)/dtime
1924         conv_t(i,k) = d_t_dyn(i,k)
1925     .               + d_t_vdf(i,k)/dtime
1926      ENDDO
1927      ENDDO
1928      IF (check) THEN
1929         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1930         PRINT*, "avantcon=", za
1931      ENDIF
1932      zx_ajustq = .FALSE.
1933      IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1934      IF (zx_ajustq) THEN
1935         DO i = 1, klon
1936            z_avant(i) = 0.0
1937         ENDDO
1938         DO k = 1, klev
1939         DO i = 1, klon
1940            z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1941     .                        *(paprs(i,k)-paprs(i,k+1))/RG
1942         ENDDO
1943         ENDDO
1944      ENDIF
1945      IF (iflag_con.EQ.1) THEN
1946          stop'reactiver le call conlmd dans physiq.F'
1947c     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1948c    .             d_t_con, d_q_con,
1949c    .             rain_con, snow_con, ibas_con, itop_con)
1950      ELSE IF (iflag_con.EQ.2) THEN
1951      CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1952     e            conv_t, conv_q, zxfluxq(1,1), omega,
1953     s            d_t_con, d_q_con, rain_con, snow_con,
1954     s            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1955     s            kcbot, kctop, kdtop, pmflxr, pmflxs)
1956      WHERE (rain_con < 0.) rain_con = 0.
1957      WHERE (snow_con < 0.) snow_con = 0.
1958      DO i = 1, klon
1959         ibas_con(i) = klev+1 - kcbot(i)
1960         itop_con(i) = klev+1 - kctop(i)
1961      ENDDO
1962      ELSE IF (iflag_con.GE.3) THEN
1963c nb of tracers for the KE convection:
1964          if (nqmax .GE. 4) then
1965              ntra = nbtr
1966          else
1967              ntra = 1
1968          endif
1969          if (iflag_con.eq.4) then ! vectorise
1970          CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1971     .        u_seri,v_seri,tr_seri,nbtr,
1972     .        ema_work1,ema_work2,
1973     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1974     .        rain_con, snow_con, ibas_con, itop_con,
1975     .        upwd,dnwd,dnwd0,
1976c    .        Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
1977     .        Ma,cape,tvp,iflagctrl,
1978     .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1979
1980          else
1981
1982          CALL conema (dtime,paprs,pplay,t_seri,q_seri,
1983     .        u_seri,v_seri,tr_seri,nbtr,
1984     .        ema_work1,ema_work2,
1985     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1986     .        rain_con, snow_con, ibas_con, itop_con,
1987     .        upwd,dnwd,dnwd0,bas,top,
1988     .        Ma,cape,tvp,rflag,
1989     .       pbase
1990     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1991          endif
1992          DO i = 1, klon
1993            ema_pcb(i)  = pbase(i)
1994          ENDDO
1995          DO i = 1, klon
1996            ema_pct(i)  = paprs(i,itop_con(i))
1997          ENDDO
1998          DO i = 1, klon
1999            ema_cbmf(i) = ema_workcbmf(i)
2000          ENDDO     
2001      ELSE
2002          PRINT*, "iflag_con non-prevu", iflag_con
2003          CALL abort
2004      ENDIF
2005
2006      CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2007     .              d_u_con, d_v_con)
2008      DO k = 1, klev
2009        DO i = 1, klon
2010         t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2011         q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2012         u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2013         v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2014        ENDDO
2015      ENDDO
2016      IF (check) THEN
2017          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2018          PRINT*, "aprescon=", za
2019          zx_t = 0.0
2020          za = 0.0
2021          DO i = 1, klon
2022            za = za + paire(i)/FLOAT(klon)
2023            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2024          ENDDO
2025          zx_t = zx_t/za*dtime
2026          PRINT*, "Precip=", zx_t
2027      ENDIF
2028      IF (zx_ajustq) THEN
2029          DO i = 1, klon
2030            z_apres(i) = 0.0
2031          ENDDO
2032          DO k = 1, klev
2033            DO i = 1, klon
2034              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2035     .            *(paprs(i,k)-paprs(i,k+1))/RG
2036            ENDDO
2037          ENDDO
2038          DO i = 1, klon
2039            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2040     .          /z_apres(i)
2041          ENDDO
2042          DO k = 1, klev
2043            DO i = 1, klon
2044              IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2045     .            z_factor(i).LT.(1.0-1.0E-08)) THEN
2046                  q_seri(i,k) = q_seri(i,k) * z_factor(i)
2047              ENDIF
2048            ENDDO
2049          ENDDO
2050      ENDIF
2051      zx_ajustq=.FALSE.
2052c
2053      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2054c
2055          IF (iflag_con .LT. 2 .AND.  iflag_con .GT. 4 ) THEN
2056              PRINT*, 'Pour l instant, seul conflx fonctionne ',
2057     $            'avec traceurs', iflag_con
2058              PRINT*,' Mettre iflag_con',
2059     $            ' = 2, 3 ou 4 dans run.def et repasser'
2060              CALL abort
2061              ENDIF
2062c
2063      ENDIF !--nqmax.GT.2
2064c
2065c Appeler l'ajustement sec
2066c
2067      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2068      DO k = 1, klev
2069      DO i = 1, klon
2070         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2071         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2072      ENDDO
2073      ENDDO
2074
2075c   RATQS
2076      if (iflag_con.eq.2) then
2077          flag_ratqs=0
2078      else
2079          flag_ratqs=1
2080      endif
2081      call calcratqs (flag_ratqs,
2082     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
2083     O           ,ratqs,zpt_conv)
2084c
2085c Appeler le processus de condensation a grande echelle
2086c et le processus de precipitation
2087c
2088      CALL fisrtilp_tr(dtime,paprs,pplay,
2089     .           t_seri, q_seri,ratqs,
2090     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2091     .           rain_lsc, snow_lsc,
2092     .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
2093     .           frac_impa, frac_nucl,
2094     .           prfl, psfl)
2095      WHERE (rain_lsc < 0) rain_lsc = 0.
2096      WHERE (snow_lsc < 0) snow_lsc = 0.
2097      DO k = 1, klev
2098      DO i = 1, klon
2099         t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2100         q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2101         ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2102         cldfra(i,k) = rneb(i,k)
2103         IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2104      ENDDO
2105      ENDDO
2106      IF (check) THEN
2107         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2108         PRINT*, "apresilp=", za
2109         zx_t = 0.0
2110         za = 0.0
2111         DO i = 1, klon
2112            za = za + paire(i)/FLOAT(klon)
2113            zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2114        ENDDO
2115         zx_t = zx_t/za*dtime
2116         PRINT*, "Precip=", zx_t
2117      ENDIF
2118c
2119c Nuages diagnostiques:
2120c
2121      IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
2122      CALL diagcld1(paprs,pplay,
2123     .             rain_con,snow_con,ibas_con,itop_con,
2124     .             diafra,dialiq)
2125      DO k = 1, klev
2126      DO i = 1, klon
2127      IF (diafra(i,k).GT.cldfra(i,k)) THEN
2128         cldliq(i,k) = dialiq(i,k)
2129         cldfra(i,k) = diafra(i,k)
2130      ENDIF
2131      ENDDO
2132      ENDDO
2133      ENDIF
2134c
2135c Nuages stratus artificiels:
2136c
2137      IF (ok_stratus) THEN
2138      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2139      DO k = 1, klev
2140      DO i = 1, klon
2141      IF (diafra(i,k).GT.cldfra(i,k)) THEN
2142         cldliq(i,k) = dialiq(i,k)
2143         cldfra(i,k) = diafra(i,k)
2144      ENDIF
2145      ENDDO
2146      ENDDO
2147      ENDIF
2148c
2149c Precipitation totale
2150c
2151      DO i = 1, klon
2152         rain_fall(i) = rain_con(i) + rain_lsc(i)
2153         snow_fall(i) = snow_con(i) + snow_lsc(i)
2154      ENDDO
2155c
2156c Calculer l'humidite relative pour diagnostique
2157c
2158      DO k = 1, klev
2159      DO i = 1, klon
2160         zx_t = t_seri(i,k)
2161         IF (thermcep) THEN
2162            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2163            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2164            zx_qs  = MIN(0.5,zx_qs)
2165            zcor   = 1./(1.-retv*zx_qs)
2166            zx_qs  = zx_qs*zcor
2167         ELSE
2168           IF (zx_t.LT.t_coup) THEN
2169              zx_qs = qsats(zx_t)/pplay(i,k)
2170           ELSE
2171              zx_qs = qsatl(zx_t)/pplay(i,k)
2172           ENDIF
2173         ENDIF
2174         zx_rh(i,k) = q_seri(i,k)/zx_qs
2175      ENDDO
2176      ENDDO
2177c
2178c Calculer les parametres optiques des nuages et quelques
2179c parametres pour diagnostiques:
2180c
2181      CALL nuage (paprs, pplay,
2182     .            t_seri, cldliq, cldfra, cldtau, cldemi,
2183     .            cldh, cldl, cldm, cldt, cldq)
2184c
2185c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2186c
2187      IF (MOD(itaprad,radpas).EQ.0) THEN
2188      DO i = 1, klon
2189         albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2190     .             + falbe(i,is_lic) * pctsrf(i,is_lic)
2191     .             + falbe(i,is_ter) * pctsrf(i,is_ter)
2192     .             + falbe(i,is_sic) * pctsrf(i,is_sic)
2193         albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2194     .               + falblw(i,is_lic) * pctsrf(i,is_lic)
2195     .               + falblw(i,is_ter) * pctsrf(i,is_ter)
2196     .               + falblw(i,is_sic) * pctsrf(i,is_sic)
2197      ENDDO
2198!      if (debut) then
2199!        albsol1 = albsol
2200!        albsollw1 = albsollw
2201!      endif
2202!      albsol = albsol1
2203!      albsollw = albsollw1
2204      CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2205     e            (dist, rmu0, fract, co2_ppm, solaire,
2206     e             paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2207     e             wo,
2208     e             cldfra, cldemi, cldtau,
2209     s             heat,heat0,cool,cool0,radsol,albpla,
2210     s             topsw,toplw,solsw,sollw,
2211     s             sollwdown,
2212     s             topsw0,toplw0,solsw0,sollw0)
2213      itaprad = 0
2214      ENDIF
2215      itaprad = itaprad + 1
2216c
2217c Ajouter la tendance des rayonnements (tous les pas)
2218c
2219      DO k = 1, klev
2220      DO i = 1, klon
2221         t_seri(i,k) = t_seri(i,k)
2222     .               + (heat(i,k)-cool(i,k)) * dtime/86400.
2223      ENDDO
2224      ENDDO
2225c
2226c Calculer l'hydrologie de la surface
2227c
2228c      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2229c     .            agesno, ftsol,fqsol,fsnow, ruis)
2230c
2231      DO i = 1, klon
2232         zxqsol(i) = 0.0
2233         zxsnow(i) = 0.0
2234      ENDDO
2235      DO nsrf = 1, nbsrf
2236      DO i = 1, klon
2237         zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2238         zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2239      ENDDO
2240      ENDDO
2241c
2242c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2243c
2244c$$$      DO nsrf = 1, nbsrf
2245c$$$      DO i = 1, klon
2246c$$$         IF (pctsrf(i,nsrf).LT.epsfra) THEN
2247c$$$            fqsol(i,nsrf) = zxqsol(i)
2248c$$$            fsnow(i,nsrf) = zxsnow(i)
2249c$$$         ENDIF
2250c$$$      ENDDO
2251c$$$      ENDDO
2252c
2253c Calculer le bilan du sol et la derive de temperature (couplage)
2254c
2255      DO i = 1, klon
2256         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2257      ENDDO
2258c
2259cmoddeblott(jan95)
2260c Appeler le programme de parametrisation de l'orographie
2261c a l'echelle sous-maille:
2262c
2263      IF (ok_orodr) THEN
2264c
2265c  selection des points pour lesquels le shema est actif:
2266        igwd=0
2267        DO i=1,klon
2268        itest(i)=0
2269c        IF ((zstd(i).gt.10.0)) THEN
2270        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2271          itest(i)=1
2272          igwd=igwd+1
2273          idx(igwd)=i
2274        ENDIF
2275        ENDDO
2276c        igwdim=MAX(1,igwd)
2277c
2278        CALL drag_noro(klon,klev,dtime,paprs,pplay,
2279     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
2280     e                   igwd,idx,itest,
2281     e                   t_seri, u_seri, v_seri,
2282     s                   zulow, zvlow, zustr, zvstr,
2283     s                   d_t_oro, d_u_oro, d_v_oro)
2284c
2285c  ajout des tendances
2286        DO k = 1, klev
2287        DO i = 1, klon
2288           t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2289           u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2290           v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2291        ENDDO
2292        ENDDO
2293c
2294      ENDIF ! fin de test sur ok_orodr
2295c
2296      IF (ok_orolf) THEN
2297c
2298c  selection des points pour lesquels le shema est actif:
2299        igwd=0
2300        DO i=1,klon
2301        itest(i)=0
2302        IF ((zpic(i)-zmea(i)).GT.100.) THEN
2303          itest(i)=1
2304          igwd=igwd+1
2305          idx(igwd)=i
2306        ENDIF
2307        ENDDO
2308c        igwdim=MAX(1,igwd)
2309c
2310        CALL lift_noro(klon,klev,dtime,paprs,pplay,
2311     e                   rlat,zmea,zstd,zpic,
2312     e                   itest,
2313     e                   t_seri, u_seri, v_seri,
2314     s                   zulow, zvlow, zustr, zvstr,
2315     s                   d_t_lif, d_u_lif, d_v_lif)
2316c
2317c  ajout des tendances
2318        DO k = 1, klev
2319        DO i = 1, klon
2320           t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2321           u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2322           v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2323        ENDDO
2324        ENDDO
2325c
2326      ENDIF ! fin de test sur ok_orolf
2327c
2328cAA
2329cAA Installation de l'interface online-offline pour traceurs
2330cAA
2331c====================================================================
2332c   Calcul  des tendances traceurs
2333c====================================================================
2334C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2335cKE43       des traceurs => il faut donc mettre des flags a .false.
2336      IF (iflag_con.GE.3) THEN
2337c           on ajoute les tendances calculees par KE43
2338c$$$ OM on onhibe la convection sur les traceurs
2339        DO iq=1, nqmax-2 ! Sandrine a -3 ???
2340c$$$ OM on inhibe la convection sur les traceur
2341c$$$        DO k = 1, nlev
2342c$$$        DO i = 1, klon
2343c$$$          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2344c$$$        ENDDO
2345c$$$        ENDDO
2346        WRITE(iqn,'(i2.2)') iq
2347        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2348        ENDDO
2349CMAF modif pour garder info du nombre de traceurs auxquels
2350C la physique s'applique
2351      ELSE
2352CMAF modif pour garder info du nombre de traceurs auxquels
2353C la physique s'applique
2354C
2355      call phytrac (rnpb,
2356     I                   debut,lafin,
2357     I                   nqmax-2,
2358     I                   nlon,nlev,dtime,
2359     I                   t,paprs,pplay,
2360     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2361     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2362     I                   frac_impa, frac_nucl,
2363     I                   rlon,presnivs,paire,pphis,
2364     O                   tr_seri)
2365      ENDIF
2366
2367      IF (offline) THEN
2368
2369         call phystokenc (
2370     I                   nlon,nlev,pdtphys,rlon,rlat,
2371     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2372     I                   ycoefh,yu1,yv1,ftsol,pctsrf,
2373     I                   frac_impa, frac_nucl,
2374     I                   pphis,paire,dtime,itap)
2375
2376
2377      ENDIF
2378
2379c
2380c Calculer le transport de l'eau et de l'energie (diagnostique)
2381c
2382      CALL transp (paprs,zxtsol,
2383     e                   t_seri, q_seri, u_seri, v_seri, zphi,
2384     s                   ve, vq, ue, uq)
2385c
2386c Accumuler les variables a stocker dans les fichiers histoire:
2387c
2388c
2389c
2390
2391      IF (ok_journe) THEN
2392c
2393      ndex2d = 0
2394      ndex3d = 0
2395c
2396c Champs 2D:
2397c
2398         zsto = dtime
2399         zout = dtime * FLOAT(ecrit_day)
2400
2401         i = NINT(zout/zsto)
2402         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2403         CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2404         varname = 'phis'
2405         vartitle= 'Surface geop. height'
2406         varunits= '-'
2407c        call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2408c    .                                                    varunits)
2409c
2410         i = NINT(zout/zsto)
2411         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2412         CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2413         varname = 'aire'
2414         vartitle= 'Grid area'
2415         varunits= '-'
2416c        call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2417c    .                                                    varunits)
2418C
2419      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2420      CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2421c     call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2422c    .              'Surface Temperature','K')
2423c
2424C
2425      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2426      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2427      CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2428c     call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2429c    .              'Surface Temperature','K')
2430C
2431      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2432      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2433      CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2434c     call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2435c    .              'Surface Temperature','K')
2436C
2437      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2438      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2439      CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2440c     call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2441c    .              'Surface Temperature','K')
2442C
2443      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2444      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2445      CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2446c     call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2447c    .              'Surface Temperature','K')
2448C
2449      DO i = 1, klon
2450         zx_tmp_fi2d(i) = paprs(i,1)
2451      ENDDO
2452      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2453      CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2454c Essai writephys
2455      varname = 'psol'
2456      vartitle= 'pression au sol'
2457      varunits= 'hPa'
2458c     call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2459c    .                                                    varunits)
2460c
2461      DO i = 1, klon
2462         zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2463      ENDDO
2464      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2465      CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2466c     call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2467c    .              'Precipitation','mm/day')
2468
2469
2470c
2471      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2472      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2473c     call writephy(fid_day,prof2d_av,'snow',snow_fall,
2474c    .              'Snow','mm/day')
2475c
2476      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2477      CALL histwrite(nid_day,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2478c     call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2479c    .              'Snow cover','mm')
2480c
2481      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2482      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2483c     call writephy(fid_day,prof2d_av,'evap',evap,
2484c    .              'Evaporation','mm/day')
2485c
2486      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2487      CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2488c     call writephy(fid_day,prof2d_av,'tops',topsw,
2489c    .              'Solar rad. at TOA','W/m2')
2490c
2491      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2492      CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2493c     call writephy(fid_day,prof2d_av,'topl',toplw,
2494c    .              'IR rad. at TOA','W/m2')
2495c
2496      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2497      CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2498c     call writephy(fid_day,prof2d_av,'sols',solsw,
2499c    .              'Solar rad. at surf.','W/m2')
2500c
2501      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2502      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2503c     call writephy(fid_day,prof2d_av,'soll',sollw,
2504c    .              'IR rad. at surface','W/m2')
2505c
2506      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2507      CALL histwrite(nid_day,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2508c     call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2509c    .              'Down. IR rad. at surface','W/m2')
2510c
2511      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2512      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2513c     call writephy(fid_day,prof2d_av,'bils',bils,
2514c    .              'Surf. total heat flux','W/m2')
2515c
2516      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2517      CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2518c     call writephy(fid_day,prof2d_av,'sens',sens,
2519c    .              'Sensible heat flux','W/m2')
2520c
2521      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2522      CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2523c     call writephy(fid_day,prof2d_av,'fder',fder,
2524c    .              'Heat flux derivation','W/m2')
2525c
2526c
2527      DO nsrf = 1, nbsrf
2528C§§§
2529        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2530        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2531        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
2532     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2533c       call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2534c    .                pctsrf( 1 : klon, nsrf),
2535c    .                'Fraction'//clnsurf(nsrf),'-')
2536C
2537        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2538        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2539        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itap,
2540     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2541c       call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2542c    .                ftsol( 1 : klon, nsrf),
2543c    .                'Surf. Temp'//clnsurf(nsrf),'K')
2544C
2545        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2546        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2547        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
2548     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2549c       call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2550c    .                fluxt( 1 : klon, 1, nsrf),
2551c    .                'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2552
2553        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2554        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2555        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
2556     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2557c       call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2558c    .                fluxlat( 1 : klon, nsrf),
2559c    .                'Latent heat flux '//clnsurf(nsrf),'W/m2')
2560C
2561        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2562        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2563        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
2564     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2565c       call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2566c    .                fluxu( 1 : klon, 1, nsrf),
2567c    .                'Zonal wind stress '//clnsurf(nsrf),'Pa')
2568C     
2569        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2570        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2571        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
2572     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2573c       call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2574c    .                fluxv( 1 : klon, 1, nsrf),
2575c    .                'Meridional wind stress '//clnsurf(nsrf),'Pa')
2576C
2577        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2578        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2579        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itap,
2580     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2581c       call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2582c    .                falbe( 1 : klon, nsrf),
2583c    .                'Albedo surf. SW'//clnsurf(nsrf),'-')
2584c       call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2585c    .                falblw( 1 : klon, nsrf),
2586c    .                'Albedo surf. LW'//clnsurf(nsrf),'-')
2587C
2588        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2589        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2590        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itap,
2591     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2592c       call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2593c    .                frugs( 1 : klon, nsrf),
2594c    .                'Rugosity '//clnsurf(nsrf),' - ')
2595C
2596      END DO 
2597C
2598c$$$      DO i = 1, klon
2599c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2600c$$$      ENDDO
2601c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2602c$$$      CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2603c
2604      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2605      CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2606c     call writephy(fid_day,prof2d_av,'cldl',cldl,
2607c    .              'Low-level cloudiness','-')
2608c
2609      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2610      CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2611c     call writephy(fid_day,prof2d_av,'cldm',cldm,
2612c    .              'Mid-level cloudiness','-')
2613c
2614      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2615      CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2616c     call writephy(fid_day,prof2d_av,'cldh',cldh,
2617c    .              'High-level cloudiness','-')
2618c
2619      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2620      CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2621c     call writephy(fid_day,prof2d_av,'cldt',cldt,
2622c    .              'Total cloudiness','-')
2623c
2624      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2625      CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2626c     call writephy(fid_day,prof2d_av,'cldq',cldq,
2627c    .              'Cloud liquid water path','-')
2628c
2629c Champs 3D:
2630c
2631      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2632      CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
2633     .                                   iim*jjmp1*klev,ndex3d)
2634c Essai writephys
2635      varname = 'temp'
2636      vartitle= 'temperature 3D'
2637      varunits= 'K'
2638c     call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2639c
2640      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2641      CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
2642     .                                   iim*jjmp1*klev,ndex3d)
2643c     call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2644c    .              'Specific humidity','Kg/Kg')
2645c
2646      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2647      CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
2648     .                                   iim*jjmp1*klev,ndex3d)
2649c     call writephy(fid_day,prof3d_av,'geop',zphi,
2650c    .              'Geopotential height','m')
2651c
2652      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2653      CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
2654     .                                   iim*jjmp1*klev,ndex3d)
2655c     call writephy(fid_day,prof3d_av,'vitu',u_seri,
2656c    .              'Zonal wind','m/s')
2657c
2658      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2659      CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
2660     .                                   iim*jjmp1*klev,ndex3d)
2661c     call writephy(fid_day,prof3d_av,'vitv',v_seri,
2662c    .              'Meridional wind','m/s')
2663c
2664      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2665      CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
2666     .                                   iim*jjmp1*klev,ndex3d)
2667c     call writephy(fid_day,prof3d_av,'vitw',omega,
2668c    .              'Vertical wind','m/s')
2669c
2670      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2671      CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
2672     .                                   iim*jjmp1*klev,ndex3d)
2673c     call writephy(fid_day,prof3d_av,'pres',pplay,
2674c    .              'Air pressure','Pa')
2675
2676c
2677      if (ok_sync) then
2678c       call writephy_sync(fid_day)
2679        call histsync(nid_day)
2680      endif
2681      ENDIF
2682C
2683      IF (ok_mensuel) THEN
2684c
2685      ndex2d = 0
2686      ndex3d = 0
2687c
2688c Champs 2D:
2689c
2690         zsto = dtime
2691         zout = dtime * ecrit_mth
2692
2693         i = NINT(zout/zsto)
2694         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2695         CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2696C
2697         i = NINT(zout/zsto)
2698         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2699         CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2700
2701      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2702      CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2703c
2704      DO i = 1, klon
2705         zx_tmp_fi2d(i) = paprs(i,1)
2706      ENDDO
2707      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2708      CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2709c
2710      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2711      CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2712c
2713      DO i = 1, klon
2714         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2715      ENDDO
2716      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2717      CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2718c
2719      DO i = 1, klon
2720         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2721      ENDDO
2722      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2723      CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2724c
2725      DO i = 1, klon
2726         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2727      ENDDO
2728      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2729      CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2730c
2731      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2732      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2733c
2734      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2735      CALL histwrite(nid_mth,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2736c
2737      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2738      CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2739c
2740      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2741      CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2742c
2743      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2744      CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2745c
2746      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2747      CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2748c
2749      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2750      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2751c
2752      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2753      CALL histwrite(nid_mth,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2754c
2755      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2756      CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2757c
2758      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2759      CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2760c
2761      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2762      CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2763c
2764      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2765      CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2766c
2767      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2768      CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2769c
2770      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2771      CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2772c
2773      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2774      CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2775c
2776c
2777c      DO i = 1, klon
2778c         zx_tmp_fi2d(i) = fluxu(i,1)
2779c      ENDDO
2780c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2781c      CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2782c
2783c      DO i = 1, klon
2784c         zx_tmp_fi2d(i) = fluxv(i,1)
2785c      ENDDO
2786c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2787c      CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2788c
2789      DO nsrf = 1, nbsrf
2790C§§§
2791        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2792        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2793        CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap,
2794     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2795C
2796        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2797        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2798        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itap,
2799     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2800C
2801        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2802        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2803        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
2804     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2805C
2806        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2807        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2808        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
2809     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2810C
2811        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2812        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2813        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
2814     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2815C     
2816        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2817        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2818        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
2819     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2820C
2821        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2822        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2823        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itap,
2824     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2825C
2826        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2827        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2828        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itap,
2829     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2830c
2831      zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2832      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2833      CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itap
2834     $    ,zx_tmp_2d,iim*jjmp1,ndex2d)
2835
2836      END DO 
2837c$$$      DO i = 1, klon
2838c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2839c$$$      ENDDO
2840c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2841c$$$      CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2842c
2843      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2844      CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2845      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2846      CALL histwrite(nid_mth,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2847c
2848      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2849      CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2850c
2851      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2852      CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2853c
2854      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2855      CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2856c
2857      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2858      CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2859c
2860      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2861      CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2862c
2863      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2864      CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2865c
2866      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2867      CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2868c
2869      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2870      CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2871c
2872      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2873      CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2874c
2875      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2876      CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2877c
2878      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2879      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2880cKE43
2881      IF (iflag_con .GE. 3) THEN ! sb
2882c
2883      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
2884      CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2885c
2886      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
2887      CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2888c
2889      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
2890      CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2891c
2892      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
2893      CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2894c
2895c
2896      ENDIF
2897c34EK
2898c
2899c Champs 3D:
2900C
2901      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2902      CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2903     .                                   iim*jjmp1*klev,ndex3d)
2904c
2905      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2906      CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2907     .                                   iim*jjmp1*klev,ndex3d)
2908c
2909      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2910      CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2911     .                                   iim*jjmp1*klev,ndex3d)
2912c
2913      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2914      CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2915     .                                   iim*jjmp1*klev,ndex3d)
2916c
2917      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2918      CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2919     .                                   iim*jjmp1*klev,ndex3d)
2920c
2921      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2922      CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2923     .                                   iim*jjmp1*klev,ndex3d)
2924c
2925      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2926      CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2927     .                                   iim*jjmp1*klev,ndex3d)
2928c
2929      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2930      CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2931     .                                   iim*jjmp1*klev,ndex3d)
2932c
2933      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2934      CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2935     .                                   iim*jjmp1*klev,ndex3d)
2936c
2937      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2938      CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2939     .                                   iim*jjmp1*klev,ndex3d)
2940c
2941      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2942      CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2943     .                                   iim*jjmp1*klev,ndex3d)
2944c
2945      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2946      CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2947     .                                   iim*jjmp1*klev,ndex3d)
2948c
2949      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2950      CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2951     .                                   iim*jjmp1*klev,ndex3d)
2952c
2953      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2954      CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2955     .                                   iim*jjmp1*klev,ndex3d)
2956c
2957      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2958      CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2959     .                                   iim*jjmp1*klev,ndex3d)
2960c
2961      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2962      CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2963     .                                   iim*jjmp1*klev,ndex3d)
2964c
2965      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2966      CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2967     .                                   iim*jjmp1*klev,ndex3d)
2968c
2969      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2970      CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2971     .                                   iim*jjmp1*klev,ndex3d)
2972c
2973      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2974      CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2975     .                                   iim*jjmp1*klev,ndex3d)
2976c
2977      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2978      CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2979     .                                   iim*jjmp1*klev,ndex3d)
2980c
2981      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
2982      CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
2983     .                                   iim*(jjmp1)*klev,ndex3d)
2984c
2985      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
2986      CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
2987     .                                   iim*(jjmp1)*klev,ndex3d)
2988c
2989      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
2990      CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
2991     .                                   iim*jjmp1*klev,ndex3d)
2992c
2993      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
2994      CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
2995     .                                   iim*jjmp1*klev,ndex3d)
2996c
2997      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
2998      CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
2999     .                                   iim*jjmp1*klev,ndex3d)
3000c
3001      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
3002      CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
3003     .                                   iim*jjmp1*klev,ndex3d)
3004c
3005      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3006      CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
3007     .                                   iim*jjmp1*klev,ndex3d)
3008c
3009      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3010      CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
3011     .                                   iim*jjmp1*klev,ndex3d)
3012c
3013      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3014      CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
3015     .                                   iim*jjmp1*klev,ndex3d)
3016c
3017      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3018      CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
3019     .                                   iim*jjmp1*klev,ndex3d)
3020c
3021      IF (ok_orodr) THEN
3022      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3023      CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
3024     .                                   iim*jjmp1*klev,ndex3d)
3025c
3026      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3027      CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
3028     .                                   iim*jjmp1*klev,ndex3d)
3029c
3030      ENDIF
3031C
3032      IF (ok_orolf) THEN
3033      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3034      CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
3035     .                                   iim*jjmp1*klev,ndex3d)
3036c
3037      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3038      CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
3039     .                                   iim*jjmp1*klev,ndex3d)
3040      ENDIF
3041C
3042      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3043      CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
3044     .                                   iim*jjmp1*klev,ndex3d)
3045c
3046      IF (nqmax.GE.3) THEN
3047      DO iq=1,nqmax-2
3048      IF (iq.LE.99) THEN
3049         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3050         WRITE(str2,'(i2.2)') iq
3051         CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
3052     .                                   iim*jjmp1*klev,ndex3d)
3053      ELSE
3054         PRINT*, "Trop de traceurs"
3055         CALL abort
3056      ENDIF
3057      ENDDO
3058      ENDIF
3059cKE43
3060      IF (iflag_con.GE.3) THEN ! (sb)
3061c
3062      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3063      CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
3064     .                                   iim*jjmp1*klev,ndex3d)
3065c
3066      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3067      CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
3068     .                                   iim*jjmp1*klev,ndex3d)
3069c
3070      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3071      CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
3072     .                                   iim*jjmp1*klev,ndex3d)
3073c
3074      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3075      CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
3076     .                                   iim*jjmp1*klev,ndex3d)
3077c
3078c
3079      ENDIF
3080c34EK
3081c
3082      if (ok_sync) then
3083        call histsync(nid_mth)
3084      endif
3085      ENDIF
3086c
3087      IF (ok_instan) THEN
3088c
3089      ndex2d = 0
3090      ndex3d = 0
3091c
3092c Champs 2D:
3093c
3094         zsto = dtime * ecrit_ins
3095         zout = dtime * ecrit_ins
3096
3097         i = NINT(zout/zsto)
3098         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3099         CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3100c
3101         i = NINT(zout/zsto)
3102         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3103         CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3104
3105      DO i = 1, klon
3106         zx_tmp_fi2d(i) = paprs(i,1)
3107      ENDDO
3108      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3109      CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3110c
3111      DO i = 1, klon
3112         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3113      ENDDO
3114      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3115      CALL histwrite(nid_ins,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3116c
3117      DO i = 1, klon
3118         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3119      ENDDO
3120      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3121      CALL histwrite(nid_ins,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3122c
3123      DO i = 1, klon
3124         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3125      ENDDO
3126      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3127      CALL histwrite(nid_ins,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3128
3129      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3130      CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3131c
3132      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3133      CALL histwrite(nid_ins,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3134
3135c
3136      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3137      CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3138c
3139      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3140      CALL histwrite(nid_ins,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3141c
3142      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3143      CALL histwrite(nid_ins,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3144c
3145      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3146      CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3147c
3148      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3149      CALL histwrite(nid_ins,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3150c
3151      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3152      CALL histwrite(nid_ins,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3153c
3154      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3155      CALL histwrite(nid_ins,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3156c
3157      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3158      CALL histwrite(nid_ins,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3159c
3160      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3161      CALL histwrite(nid_ins,"dtsvdfo",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3162c
3163      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3164      CALL histwrite(nid_ins,"dtsvdft",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3165c
3166      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3167      CALL histwrite(nid_ins,"dtsvdfg",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3168c
3169      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3170      CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3171
3172      DO nsrf = 1, nbsrf
3173C§§§
3174        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3175        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3176        CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap,
3177     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3178C
3179        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3180        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3181        CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
3182     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3183C
3184        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3185        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3186        CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
3187     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3188C
3189        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3190        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3191        CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap,
3192     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3193C
3194        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3195        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3196        CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
3197     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3198C     
3199        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3200        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3201        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
3202     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3203C
3204        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3205        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3206        CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itap,
3207     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3208C
3209        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3210        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3211        CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itap,
3212     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3213C
3214      END DO 
3215      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3216      CALL histwrite(nid_ins,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3217      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3218      CALL histwrite(nid_ins,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3219c
3220      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3221      CALL histwrite(nid_ins,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3222c
3223      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3224      CALL histwrite(nid_ins,"rugs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3225c
3226c Champs 3D:
3227c
3228      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3229      CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
3230     .                                   iim*jjmp1*klev,ndex3d)
3231c
3232      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3233      CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
3234     .                                   iim*jjmp1*klev,ndex3d)
3235c
3236      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3237      CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
3238     .                                   iim*jjmp1*klev,ndex3d)
3239c
3240      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3241      CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
3242     .                                   iim*jjmp1*klev,ndex3d)
3243c
3244      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3245      CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
3246     .                                   iim*jjmp1*klev,ndex3d)
3247c
3248      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3249      CALL histwrite(nid_ins,"dtvdf",itap,zx_tmp_3d,
3250     .                                   iim*jjmp1*klev,ndex3d)
3251c
3252      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3253      CALL histwrite(nid_ins,"dqvdf",itap,zx_tmp_3d,
3254     .                                   iim*jjmp1*klev,ndex3d)
3255
3256c
3257      if (ok_sync) then
3258        call histsync(nid_ins)
3259      endif
3260      ENDIF
3261c
3262c
3263c Ecrire la bande regionale (binaire grads)
3264      IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3265         CALL ecriregs(84,zxtsol)
3266         CALL ecriregs(84,paprs(1,1))
3267         CALL ecriregs(84,topsw)
3268         CALL ecriregs(84,toplw)
3269         CALL ecriregs(84,solsw)
3270         CALL ecriregs(84,sollw)
3271         CALL ecriregs(84,rain_fall)
3272         CALL ecriregs(84,snow_fall)
3273         CALL ecriregs(84,evap)
3274         CALL ecriregs(84,sens)
3275         CALL ecriregs(84,bils)
3276         CALL ecriregs(84,pctsrf(1,is_sic))
3277         CALL ecriregs(84,zxfluxu(1,1))
3278         CALL ecriregs(84,zxfluxv(1,1))
3279         CALL ecriregs(84,ue)
3280         CALL ecriregs(84,ve)
3281         CALL ecriregs(84,uq)
3282         CALL ecriregs(84,vq)
3283c
3284         CALL ecrirega(84,u_seri)
3285         CALL ecrirega(84,v_seri)
3286         CALL ecrirega(84,omega)
3287         CALL ecrirega(84,t_seri)
3288         CALL ecrirega(84,zphi)
3289         CALL ecrirega(84,q_seri)
3290         CALL ecrirega(84,cldfra)
3291         CALL ecrirega(84,cldliq)
3292         CALL ecrirega(84,pplay)
3293
3294
3295cc         CALL ecrirega(84,d_t_dyn)
3296cc         CALL ecrirega(84,d_q_dyn)
3297cc         CALL ecrirega(84,heat)
3298cc         CALL ecrirega(84,cool)
3299cc         CALL ecrirega(84,d_t_con)
3300cc         CALL ecrirega(84,d_q_con)
3301cc         CALL ecrirega(84,d_t_lsc)
3302cc         CALL ecrirega(84,d_q_lsc)
3303      ENDIF
3304c
3305c Convertir les incrementations en tendances
3306c
3307      DO k = 1, klev
3308      DO i = 1, klon
3309         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3310         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3311         d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3312         d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3313         d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3314      ENDDO
3315      ENDDO
3316c
3317      IF (nqmax.GE.3) THEN
3318      DO iq = 3, nqmax
3319      DO  k = 1, klev
3320      DO  i = 1, klon
3321         d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3322      ENDDO
3323      ENDDO
3324      ENDDO
3325      ENDIF
3326c
3327c Sauvegarder les valeurs de t et q a la fin de la physique:
3328c
3329      DO k = 1, klev
3330      DO i = 1, klon
3331         t_ancien(i,k) = t_seri(i,k)
3332         q_ancien(i,k) = q_seri(i,k)
3333      ENDDO
3334      ENDDO
3335c
3336c====================================================================
3337c Si c'est la fin, il faut conserver l'etat de redemarrage
3338c====================================================================
3339c
3340      IF (lafin) THEN
3341ccc         IF (ok_oasis) CALL quitcpl
3342         CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3343     .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3344     .      falbe, fevap, rain_fall, snow_fall,
3345     .      solsw, sollwdown,dlw,
3346     .      radsol,frugs,agesno,
3347     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3348     .      t_ancien, q_ancien)
3349      ENDIF
3350
3351      RETURN
3352      END
3353      FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3354      IMPLICIT none
3355c
3356c Calculer et imprimer l'eau totale. A utiliser pour verifier
3357c la conservation de l'eau
3358c
3359#include "YOMCST.h"
3360      INTEGER klon,klev
3361      REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3362      REAL aire(klon)
3363      REAL qtotal, zx, qcheck
3364      INTEGER i, k
3365c
3366      zx = 0.0
3367      DO i = 1, klon
3368         zx = zx + aire(i)
3369      ENDDO
3370      qtotal = 0.0
3371      DO k = 1, klev
3372      DO i = 1, klon
3373         qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3374     .                     *(paprs(i,k)-paprs(i,k+1))/RG
3375      ENDDO
3376      ENDDO
3377c
3378      qcheck = qtotal/zx
3379c
3380      RETURN
3381      END
3382      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3383      IMPLICIT none
3384c
3385c Tranformer une variable de la grille physique a
3386c la grille d'ecriture
3387c
3388      INTEGER nfield,nlon,iim,jjmp1, jjm
3389      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3390c
3391      INTEGER i, n, ig
3392c
3393      jjm = jjmp1 - 1
3394      DO n = 1, nfield
3395         DO i=1,iim
3396            ecrit(i,n) = fi(1,n)
3397            ecrit(i+jjm*iim,n) = fi(nlon,n)
3398         ENDDO
3399         DO ig = 1, nlon - 2
3400           ecrit(iim+ig,n) = fi(1+ig,n)
3401         ENDDO
3402      ENDDO
3403      RETURN
3404      END
3405
Note: See TracBrowser for help on using the repository browser.