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

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

Tag version 0 qui marche en couple/force
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 120.1 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      real zpt_conv(klon,klev)
540
541c
542c Variables liees a l'ecriture de la bande histoire physique
543c
544      INTEGER ecrit_mth
545      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
546c
547      INTEGER ecrit_day
548      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
549c
550      INTEGER ecrit_ins
551      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
552c
553      INTEGER ecrit_reg
554      SAVE ecrit_reg   ! frequence d'ecriture
555c
556c
557c
558c Variables locales pour effectuer les appels en serie
559c
560      REAL t_seri(klon,klev), q_seri(klon,klev)
561      REAL ql_seri(klon,klev)
562      REAL u_seri(klon,klev), v_seri(klon,klev)
563c
564      REAL tr_seri(klon,klev,nbtr)
565      REAL d_tr(klon,klev,nbtr)
566
567      REAL zx_rh(klon,klev)
568
569      INTEGER        length
570      PARAMETER    ( length = 100 )
571      REAL tabcntr0( length       )
572c
573      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
574      REAL zx_tmp_fi2d(klon)
575      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
576      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
577c
578      INTEGER nid_day, nid_mth, nid_ins
579      SAVE nid_day, nid_mth, nid_ins
580c
581      INTEGER nhori, nvert
582      REAL zsto, zout
583      real zjulian
584      save zjulian
585
586      character*20 modname
587      character*80 abort_message
588      logical ok_sync
589      real date0
590
591C essai writephys
592      integer fid_day, fid_mth, fid_ins
593      parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
594      integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
595      parameter (prof2d_on = 1, prof3d_on = 2,
596     .           prof2d_av = 3, prof3d_av = 4)
597      character*30 nom_fichier
598      character*10 varname
599      character*40 vartitle
600      character*20 varunits
601c
602c Declaration des constantes et des fonctions thermodynamiques
603c
604#include "YOMCST.h"
605#include "YOETHF.h"
606#include "FCTTRE.h"
607c======================================================================
608      modname = 'physiq'
609      ok_sync=.TRUE.
610      IF (nqmax .LT. 2) THEN
611         PRINT*, 'eaux vapeur et liquide sont indispensables'
612         CALL ABORT
613      ENDIF
614      IF (debut) THEN
615         CALL suphec ! initialiser constantes et parametres phys.
616      ENDIF
617
618
619c======================================================================
620      xjour = rjourvrai
621c
622c Si c'est le debut, il faut initialiser plusieurs choses
623c          ********
624c
625       IF (debut) THEN
626
627c
628c appel a la lecture du run.def physique
629c
630         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
631     .                  ok_instan)
632
633         DO k = 2, nvm          ! pas de vegetation
634            DO i = 1, klon
635               veget(i,k) = 0.0
636            ENDDO
637         ENDDO
638         DO i = 1, klon
639            veget(i,1) = 1.0    ! il n'y a que du desert
640         ENDDO
641         PRINT*, 'Pas de vegetation; desert partout'
642c
643c
644c Initialiser les compteurs:
645c
646
647         frugs = 0.
648         itap    = 0
649         itaprad = 0
650c
651         CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
652     .       rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow,
653     .       falbe, fevap, rain_fall,snow_fall,solsw, sollwdown,
654     .       dlw,radsol,frugs,agesno,clesphy0,
655     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
656     .       t_ancien, q_ancien, ancien_ok )
657
658c
659         radpas = NINT( 86400./dtime/nbapp_rad)
660
661c
662         CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
663     ,                    ok_instan, ok_region )
664c
665         IF (ABS(dtime-pdtphys).GT.0.001) THEN
666            PRINT*, 'Pas physique n est pas correcte',dtime,pdtphys
667            abort_message=' See above '
668            call abort_gcm(modname,abort_message,1)
669         ENDIF
670         IF (nlon .NE. klon) THEN
671            PRINT*, 'nlon et klon ne sont pas coherents', nlon, klon
672            abort_message=' See above '
673            call abort_gcm(modname,abort_message,1)
674         ENDIF
675         IF (nlev .NE. klev) THEN
676            PRINT*, 'nlev et klev ne sont pas coherents', nlev, klev
677            abort_message=' See above '
678            call abort_gcm(modname,abort_message,1)
679         ENDIF
680c
681         IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN
682           PRINT*, 'Nbre d appels au rayonnement insuffisant'
683           PRINT*, "Au minimum 4 appels par jour si cycle diurne"
684           abort_message=' See above '
685           call abort_gcm(modname,abort_message,1)
686         ENDIF
687         PRINT*, "Clef pour la convection, iflag_con=", iflag_con
688c
689cKE43
690c Initialisation pour la convection de K.E. (sb):
691         IF (iflag_con.EQ.4) THEN
692
693         PRINT*, "*** Convection de Kerry Emanuel 4.3  "
694         PRINT*, "On va utiliser le melange convectif des traceurs qui"
695         PRINT*, "est calcule dans convect4.3"
696         PRINT*, " !!! penser aux logical flags de phytrac"
697
698          DO i = 1, klon
699           ema_cbmf(i) = 0.
700           ema_pcb(i)  = 0.
701           ema_pct(i)  = 0.
702           ema_workcbmf(i) = 0.
703          ENDDO
704         ENDIF
705c34EK
706         IF (ok_orodr) THEN
707         DO i=1,klon
708         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
709         ENDDO
710         CALL SUGWD(klon,klev,paprs,pplay)
711         DO i=1,klon
712         zuthe(i)=0.
713         zvthe(i)=0.
714         if(zstd(i).gt.10.)then
715           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
716           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
717         endif
718         ENDDO
719         ENDIF
720c
721c
722         lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
723         PRINT*,'La frequence de lecture surface est de ', lmt_pas
724c
725         ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
726         IF (ok_mensuel) THEN
727         PRINT*, 'La frequence de sortie mensuelle est de ', ecrit_mth
728         ENDIF
729         ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
730         IF (ok_journe) THEN
731         PRINT*, 'La frequence de sortie journaliere est de ',ecrit_day
732         ENDIF
733ccc         ecrit_ins = NINT(86400./dtime *0.5)  ! 2 fois par jour
734ccc         ecrit_ins = NINT(86400./dtime *0.25)  ! 4 fois par jour
735         ecrit_ins = NINT(86400./dtime/48.)  ! a chaque pas de temps
736         ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
737         IF (ok_instan) THEN
738         PRINT*, 'La frequence de sortie instant. est de ', ecrit_ins
739         ENDIF
740         ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
741         IF (ok_region) THEN
742         PRINT*, 'La frequence de sortie region est de ', ecrit_reg
743         ENDIF
744
745c
746c Initialiser le couplage si necessaire
747c
748      npas = 0
749      nexca = 0
750      if (ocean == 'couple') then
751        npas = itaufin/ iphysiq
752        nexca = 86400 / dtime
753        write(*,*)' ##### Ocean couple #####'
754        write(*,*)' Valeurs des pas de temps'
755        write(*,*)' npas = ', npas
756        write(*,*)' nexca = ', nexca
757      endif       
758c
759c
760c Gestion calendrier
761
762         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
763         zjulian = zjulian + day_ini
764
765c
766      IF (ok_journe) THEN
767c
768         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
769         zjulian = zjulian + day_ini
770c
771         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
772         DO i = 1, iim
773            zx_lon(i,1) = rlon(i+1)
774            zx_lon(i,jjmp1) = rlon(i+1)
775         ENDDO
776         DO ll=1,klev
777            znivsig(ll)=float(ll)
778         ENDDO
779         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
780         CALL histbeg("histday", iim,zx_lon, jjmp1,zx_lat,
781     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
782     .                 nhori, nid_day)
783         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
784     .                 klev, presnivs, nvert)
785c        call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
786c    .              klev, znivsig, nvert)
787c
788         zsto = dtime
789         zout = dtime * FLOAT(ecrit_day)
790C Essai writephys
791c        nom_fichier = 'histday1'
792c        call writephy_ini(fid_day,nom_fichier,klon,iim,jjmp1,klev,
793c    .                     rlon,rlat, presnivs,
794c    .                     zjulian, dtime)
795c        call writephy_def(prof2d_on, fid_day, "once", zsto, zout, 0)
796c        call writephy_def(prof3d_on, fid_day, "once", zsto, zout,
797c    .                                                         klev)
798c        call writephy_def(prof2d_av, fid_day, "ave(X)", zsto, zout, 0)
799c        call writephy_def(prof3d_av, fid_day, "ave(X)", zsto, zout,
800c    .                                                         klev)
801 
802c
803         CALL histdef(nid_day, "phis", "Surface geop. height", "-",
804     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
805     .                "once", zsto,zout)
806c
807         CALL histdef(nid_day, "aire", "Grid area", "-",
808     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
809     .                "once", zsto,zout)
810c
811c Champs 2D:
812c
813         CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
814     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
815     .                "ave(X)", zsto,zout)
816c
817         CALL histdef(nid_day, "tter", "Surface Temperature", "K",
818     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
819     .                "ave(X)", zsto,zout)
820c
821         CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
822     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
823     .                "ave(X)", zsto,zout)
824c
825         CALL histdef(nid_day, "toce", "Surface Temperature", "K",
826     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
827     .                "ave(X)", zsto,zout)
828c
829         CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
830     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
831     .                "ave(X)", zsto,zout)
832c
833         CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
834     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
835     .                "ave(X)", zsto,zout)
836c
837         CALL histdef(nid_day, "rain", "Precipitation", "mm/day",
838     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
839     .                "ave(X)", zsto,zout)
840c
841         CALL histdef(nid_day, "snow", "Snow fall", "mm/day",
842     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
843     .                "ave(X)", zsto,zout)
844c
845         CALL histdef(nid_day, "snow_cov", "Snow cover", "mm",
846     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
847     .                "ave(X)", zsto,zout)
848c
849         CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
850     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
851     .                "ave(X)", zsto,zout)
852c
853         CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
854     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
855     .                "ave(X)", zsto,zout)
856c
857         CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
858     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
859     .                "ave(X)", zsto,zout)
860c
861         CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
862     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
863     .                "ave(X)", zsto,zout)
864c
865         CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
866     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
867     .                "ave(X)", zsto,zout)
868c
869         CALL histdef(nid_day, "solldown", "Down. IR rad. at surface",
870     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
871     .                "ave(X)", zsto,zout)
872c
873         CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
874     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
875     .                "ave(X)", zsto,zout)
876c
877         CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
878     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
879     .                "ave(X)", zsto,zout)
880c
881         CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
882     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
883     .                "ave(X)", zsto,zout)
884c
885         CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
886     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
887     .                "ave(X)", zsto,zout)
888c
889         CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
890     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
891     .                "ave(X)", zsto,zout)
892c
893C §§§ PB flux pour chauqe sous surface
894C
895         DO nsrf = 1, nbsrf
896C
897           call histdef(nid_day, "pourc_"//clnsurf(nsrf),
898     $         "Fraction"//clnsurf(nsrf), "W/m2", 
899     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
900     $         "ave(X)", zsto,zout)
901C
902           call histdef(nid_day, "tsol_"//clnsurf(nsrf),
903     $         "Fraction"//clnsurf(nsrf), "W/m2", 
904     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
905     $         "ave(X)", zsto,zout)
906C
907           call histdef(nid_day, "sens_"//clnsurf(nsrf),
908     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
909     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
910     $         "ave(X)", zsto,zout)
911c
912           call histdef(nid_day, "lat_"//clnsurf(nsrf),
913     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
914     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
915     $         "ave(X)", zsto,zout)
916C
917           call histdef(nid_day, "taux_"//clnsurf(nsrf),
918     $         "Zonal wind stress"//clnsurf(nsrf),"Pa",
919     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
920     $         "ave(X)", zsto,zout)
921
922           call histdef(nid_day, "tauy_"//clnsurf(nsrf),
923     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
924     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
925     $         "ave(X)", zsto,zout)
926C
927           call histdef(nid_day, "albe_"//clnsurf(nsrf),
928     $         "Albedo surf. "//clnsurf(nsrf), "W/m2", 
929     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
930     $         "ave(X)", zsto,zout)
931C
932           call histdef(nid_day, "rugs_"//clnsurf(nsrf),
933     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
934     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
935     $         "ave(X)", zsto,zout)
936
937C§§§
938         END DO
939           
940         CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
941     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
942     .                "ave(X)", zsto,zout)
943c
944         CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
945     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
946     .                "ave(X)", zsto,zout)
947c
948         CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
949     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
950     .                "ave(X)", zsto,zout)
951c
952         CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
953     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
954     .                "ave(X)", zsto,zout)
955c
956         CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
957     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
958     .                "ave(X)", zsto,zout)
959c
960         CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
961     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
962     .                "ave(X)", zsto,zout)
963c
964c Champs 3D:
965c
966         CALL histdef(nid_day, "temp", "Air temperature", "K",
967     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
968     .                "ave(X)", zsto,zout)
969c
970         CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
971     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
972     .                "ave(X)", zsto,zout)
973c
974         CALL histdef(nid_day, "geop", "Geopotential height", "m",
975     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
976     .                "ave(X)", zsto,zout)
977c
978         CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
979     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
980     .                "ave(X)", zsto,zout)
981c
982         CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
983     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
984     .                "ave(X)", zsto,zout)
985c
986         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
987     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
988     .                "ave(X)", zsto,zout)
989c
990         CALL histdef(nid_day, "pres", "Air pressure", "Pa",
991     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
992     .                "ave(X)", zsto,zout)
993c
994         CALL histend(nid_day)
995c
996         ndex2d = 0
997         ndex3d = 0
998c
999      ENDIF ! fin de test sur ok_journe
1000c
1001      IF (ok_mensuel) THEN
1002c
1003         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
1004         zjulian = zjulian + day_ini
1005c
1006         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1007         DO i = 1, iim
1008            zx_lon(i,1) = rlon(i+1)
1009            zx_lon(i,jjmp1) = rlon(i+1)
1010         ENDDO
1011         DO ll=1,klev
1012            znivsig(ll)=float(ll)
1013         ENDDO
1014         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1015         CALL histbeg("histmth", iim,zx_lon, jjmp1,zx_lat,
1016     .                 1,iim,1,jjmp1, 0, zjulian, dtime,
1017     .                 nhori, nid_mth)
1018         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
1019     .                 klev, presnivs, nvert)
1020c        call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
1021c    .              klev, znivsig, nvert)
1022c
1023         zsto = dtime
1024         zout = dtime * ecrit_mth
1025c
1026         CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
1027     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1028     .                "once",  zsto,zout)
1029c
1030         CALL histdef(nid_mth, "aire", "Grid area", "-",
1031     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1032     .                "once",  zsto,zout)
1033c
1034c Champs 2D:
1035c
1036         CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
1037     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1038     .                "ave(X)", zsto,zout)
1039c
1040         CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
1041     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1042     .                "ave(X)", zsto,zout)
1043c
1044         CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
1045     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1046     .                "ave(X)", zsto,zout)
1047c
1048         CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
1049     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1050     .                "ave(X)", zsto,zout)
1051c
1052         CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
1053     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1054     .                "ave(X)", zsto,zout)
1055c
1056         CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
1057     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1058     .                "ave(X)", zsto,zout)
1059c
1060         CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
1061     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1062     .                "ave(X)", zsto,zout)
1063c
1064         CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
1065     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1066     .                "ave(X)", zsto,zout)
1067c
1068         CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
1069     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1070     .                "ave(X)", zsto,zout)
1071c
1072         CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
1073     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1074     .                "ave(X)", zsto,zout)
1075c
1076         CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
1077     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1078     .                "ave(X)", zsto,zout)
1079c
1080         CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
1081     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1082     .                "ave(X)", zsto,zout)
1083c
1084         CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
1085     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1086     .                "ave(X)", zsto,zout)
1087c
1088         CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
1089     .                "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1090     .                "ave(X)", zsto,zout)
1091c
1092         CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
1093     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1094     .                "ave(X)", zsto,zout)
1095c
1096         CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
1097     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1098     .                "ave(X)", zsto,zout)
1099c
1100         CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
1101     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1102     .                "ave(X)", zsto,zout)
1103c
1104         CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
1105     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1106     .                "ave(X)", zsto,zout)
1107c
1108         CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
1109     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1110     .                "ave(X)", zsto,zout)
1111c
1112         CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
1113     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1114     .                "ave(X)", zsto,zout)
1115c
1116         CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
1117     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1118     .                "ave(X)", zsto,zout)
1119c
1120         CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
1121     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1122     .                "ave(X)", zsto,zout)
1123c
1124         CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
1125     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1126     .                "ave(X)", zsto,zout)
1127c
1128         DO nsrf = 1, nbsrf
1129C
1130           call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1131     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1132     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1133     $         "ave(X)", zsto,zout)
1134C
1135           call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
1136     $         "Fraction "//clnsurf(nsrf), "W/m2", 
1137     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1138     $         "ave(X)", zsto,zout)
1139C
1140           call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1141     $         "Sensible heat flux "//clnsurf(nsrf), "W/m2", 
1142     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1143     $         "ave(X)", zsto,zout)
1144c
1145           call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1146     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1147     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1148     $         "ave(X)", zsto,zout)
1149C
1150           call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1151     $         "Zonal wind stress"//clnsurf(nsrf), "Pa", 
1152     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1153     $         "ave(X)", zsto,zout)
1154
1155           call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1156     $         "Meridional xind stress "//clnsurf(nsrf), "Pa", 
1157     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1158     $         "ave(X)", zsto,zout)
1159c
1160           call histdef(nid_mth, "albe_"//clnsurf(nsrf),
1161     $         "Albedo surf. "//clnsurf(nsrf), "W/m2", 
1162     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1163     $         "ave(X)", zsto,zout)
1164c
1165           call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
1166     $         "Latent heat flux "//clnsurf(nsrf), "W/m2", 
1167     $         iim,jjmp1,nhori, 1,1,1, -99, 32,
1168     $         "ave(X)", zsto,zout)
1169c
1170         CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
1171     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1172     .                "ave(X)", zsto,zout)
1173
1174         END DO
1175C
1176         CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1177     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1178     .                "ave(X)", zsto,zout)
1179c
1180         CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1181     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1182     .                "ave(X)", zsto,zout)
1183         CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
1184     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1185     .                "ave(X)", zsto,zout)
1186c
1187         CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1188     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1189     .                "ave(X)", zsto,zout)
1190c
1191         CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1192     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1193     .                "ave(X)", zsto,zout)
1194c
1195         CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1196     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1197     .                "ave(X)", zsto,zout)
1198c
1199         CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1200     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1201     .                "ave(X)", zsto,zout)
1202c
1203         CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1204     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1205     .                "ave(X)", zsto,zout)
1206c
1207         CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1208     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1209     .                "ave(X)", zsto,zout)
1210c
1211         CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1212     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1213     .                "ave(X)", zsto,zout)
1214c
1215         CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1216     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1217     .                "ave(X)", zsto,zout)
1218c
1219         CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1220     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1221     .                "ave(X)", zsto,zout)
1222c
1223         CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1224     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1225     .                "ave(X)", zsto,zout)
1226c
1227         CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1228     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
1229     .                "ave(X)", zsto,zout)
1230c
1231cKE43
1232      IF (iflag_con .EQ. 4) 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,jjm+1,nhori, klev,1,klev,nvert, 32,
1338     .                "ave(X)", zsto,zout)
1339
1340         CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1341     .                iim,jjm+1,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.EQ.4) 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.EQ.3) THEN
1963          stop'reactiver le call conlmd dans physiq.F'
1964c     CALL conccm (dtime,paprs,pplay,t_seri,q_seri,conv_q,
1965c    s             d_t_con, d_q_con,
1966c    s             rain_con, snow_con, ibas_con, itop_con)
1967cKE43
1968      ELSE IF (iflag_con.EQ.4) THEN
1969c nb of tracers for the KE convection:
1970          if (nqmax .GE. 4) then
1971              ntra = nbtr
1972          else
1973              ntra = 1
1974          endif
1975cke43 (arguments inutiles enleves => des SAVE dans conema43?)
1976c$$$          CALL conema43(dtime,paprs,pplay,t_seri,q_seri,
1977c$$$     $        u_seri,v_seri,tr_seri,nbtr,
1978c$$$     .        ema_workcbmf,
1979c$$$     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1980c$$$     .        wdn, tdn, qdn,
1981c$$$     .        rain_con, snow_con, ibas_con, itop_con,
1982c$$$     .        upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag,
1983c$$$     .        pbase
1984c$$$     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
1985c$$$     .        pori_con,plcl_con,dtma_con,dtlcl_con)
1986          if (0.eq.1) then ! vectorise
1987          CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1988     .        u_seri,v_seri,tr_seri,nbtr,
1989     .        ema_work1,ema_work2,
1990     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
1991     .        rain_con, snow_con, ibas_con, itop_con,
1992     .        upwd,dnwd,dnwd0,
1993c    .        Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
1994     .        Ma,cape,tvp,iflagctrl,
1995     .       pbase
1996     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
1997
1998          else
1999
2000          CALL conema (dtime,paprs,pplay,t_seri,q_seri,
2001     $        u_seri,v_seri,tr_seri,nbtr,
2002     .        ema_work1,ema_work2,
2003     .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
2004c$$$     .        wdn, tdn, qdn,
2005     .        rain_con, snow_con, ibas_con, itop_con,
2006     .        upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag,
2007     .        pbase
2008     .        ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
2009c$$$     .        pori_con,plcl_con,dtma_con,dtlcl_con)
2010          endif
2011          DO i = 1, klon
2012            ema_pcb(i)  = pbase(i)
2013          ENDDO
2014          DO i = 1, klon
2015            ema_pct(i)  = paprs(i,itop_con(i))
2016          ENDDO
2017          DO i = 1, klon
2018            ema_cbmf(i) = ema_workcbmf(i)
2019          ENDDO     
2020      ELSE
2021          PRINT*, "iflag_con non-prevu", iflag_con
2022          CALL abort
2023      ENDIF
2024
2025      CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2026     .              d_u_con, d_v_con)
2027      DO k = 1, klev
2028        DO i = 1, klon
2029         t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2030         q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2031         u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2032         v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2033        ENDDO
2034      ENDDO
2035      IF (check) THEN
2036          za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2037          PRINT*, "aprescon=", za
2038          zx_t = 0.0
2039          za = 0.0
2040          DO i = 1, klon
2041            za = za + paire(i)/FLOAT(klon)
2042            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2043          ENDDO
2044          zx_t = zx_t/za*dtime
2045          PRINT*, "Precip=", zx_t
2046      ENDIF
2047      IF (zx_ajustq) THEN
2048          DO i = 1, klon
2049            z_apres(i) = 0.0
2050          ENDDO
2051          DO k = 1, klev
2052            DO i = 1, klon
2053              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2054     .            *(paprs(i,k)-paprs(i,k+1))/RG
2055            ENDDO
2056          ENDDO
2057          DO i = 1, klon
2058            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2059     .          /z_apres(i)
2060          ENDDO
2061          DO k = 1, klev
2062            DO i = 1, klon
2063              IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2064     .            z_factor(i).LT.(1.0-1.0E-08)) THEN
2065                  q_seri(i,k) = q_seri(i,k) * z_factor(i)
2066              ENDIF
2067            ENDDO
2068          ENDDO
2069      ENDIF
2070      zx_ajustq=.FALSE.
2071c
2072      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2073c
2074          IF (iflag_con .NE. 2 .AND.  iflag_con .NE. 4 ) THEN
2075              PRINT*, 'Pour l instant, seul conflx fonctionne ',
2076     $            'avec traceurs', iflag_con
2077              PRINT*,' Mettre iflag_con',
2078     $            ' = 2  ou 4 dans run.def et repasser'
2079              CALL abort
2080              ENDIF
2081c
2082      ENDIF !--nqmax.GT.2
2083c
2084c Appeler l'ajustement sec
2085c
2086      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2087      DO k = 1, klev
2088      DO i = 1, klon
2089         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2090         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2091      ENDDO
2092      ENDDO
2093
2094c   RATQS
2095      call calcratqs (
2096     I            paprs,pplay,q_seri,d_t_con,d_t_ajs
2097     O           ,ratqs,zpt_conv)
2098c
2099c Appeler le processus de condensation a grande echelle
2100c et le processus de precipitation
2101c
2102      CALL fisrtilp_tr(dtime,paprs,pplay,
2103     .           t_seri, q_seri,ratqs,
2104     .           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2105     .           rain_lsc, snow_lsc,
2106     .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
2107     .           frac_impa, frac_nucl,
2108     .           prfl, psfl)
2109      WHERE (rain_lsc < 0) rain_lsc = 0.
2110      WHERE (snow_lsc < 0) snow_lsc = 0.
2111      DO k = 1, klev
2112      DO i = 1, klon
2113         t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2114         q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2115         ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2116         cldfra(i,k) = rneb(i,k)
2117         IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2118      ENDDO
2119      ENDDO
2120      IF (check) THEN
2121         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2122         PRINT*, "apresilp=", za
2123         zx_t = 0.0
2124         za = 0.0
2125         DO i = 1, klon
2126            za = za + paire(i)/FLOAT(klon)
2127            zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2128        ENDDO
2129         zx_t = zx_t/za*dtime
2130         PRINT*, "Precip=", zx_t
2131      ENDIF
2132c
2133c Nuages diagnostiques:
2134c
2135      IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
2136      CALL diagcld1(paprs,pplay,
2137     .             rain_con,snow_con,ibas_con,itop_con,
2138     .             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 Nuages stratus artificiels:
2150c
2151      IF (ok_stratus) THEN
2152      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2153      DO k = 1, klev
2154      DO i = 1, klon
2155      IF (diafra(i,k).GT.cldfra(i,k)) THEN
2156         cldliq(i,k) = dialiq(i,k)
2157         cldfra(i,k) = diafra(i,k)
2158      ENDIF
2159      ENDDO
2160      ENDDO
2161      ENDIF
2162c
2163c Precipitation totale
2164c
2165      DO i = 1, klon
2166         rain_fall(i) = rain_con(i) + rain_lsc(i)
2167         snow_fall(i) = snow_con(i) + snow_lsc(i)
2168      ENDDO
2169c
2170c Calculer l'humidite relative pour diagnostique
2171c
2172      DO k = 1, klev
2173      DO i = 1, klon
2174         zx_t = t_seri(i,k)
2175         IF (thermcep) THEN
2176            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2177            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2178            zx_qs  = MIN(0.5,zx_qs)
2179            zcor   = 1./(1.-retv*zx_qs)
2180            zx_qs  = zx_qs*zcor
2181         ELSE
2182           IF (zx_t.LT.t_coup) THEN
2183              zx_qs = qsats(zx_t)/pplay(i,k)
2184           ELSE
2185              zx_qs = qsatl(zx_t)/pplay(i,k)
2186           ENDIF
2187         ENDIF
2188         zx_rh(i,k) = q_seri(i,k)/zx_qs
2189      ENDDO
2190      ENDDO
2191c
2192c Calculer les parametres optiques des nuages et quelques
2193c parametres pour diagnostiques:
2194c
2195      CALL nuage (paprs, pplay,
2196     .            t_seri, cldliq, cldfra, cldtau, cldemi,
2197     .            cldh, cldl, cldm, cldt, cldq)
2198c
2199c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2200c
2201      IF (MOD(itaprad,radpas).EQ.0) THEN
2202      DO i = 1, klon
2203         albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2204     .             + falbe(i,is_lic) * pctsrf(i,is_lic)
2205     .             + falbe(i,is_ter) * pctsrf(i,is_ter)
2206     .             + falbe(i,is_sic) * pctsrf(i,is_sic)
2207         albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2208     .               + falblw(i,is_lic) * pctsrf(i,is_lic)
2209     .               + falblw(i,is_ter) * pctsrf(i,is_ter)
2210     .               + falblw(i,is_sic) * pctsrf(i,is_sic)
2211      ENDDO
2212!      if (debut) then
2213!        albsol1 = albsol
2214!        albsollw1 = albsollw
2215!      endif
2216!      albsol = albsol1
2217!      albsollw = albsollw1
2218      CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2219     e            (dist, rmu0, fract, co2_ppm, solaire,
2220     e             paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2221     e             wo,
2222     e             cldfra, cldemi, cldtau,
2223     s             heat,heat0,cool,cool0,radsol,albpla,
2224     s             topsw,toplw,solsw,sollw,
2225     s             sollwdown,
2226     s             topsw0,toplw0,solsw0,sollw0)
2227      itaprad = 0
2228      ENDIF
2229      itaprad = itaprad + 1
2230c
2231c Ajouter la tendance des rayonnements (tous les pas)
2232c
2233      DO k = 1, klev
2234      DO i = 1, klon
2235         t_seri(i,k) = t_seri(i,k)
2236     .               + (heat(i,k)-cool(i,k)) * dtime/86400.
2237      ENDDO
2238      ENDDO
2239c
2240c Calculer l'hydrologie de la surface
2241c
2242c      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2243c     .            agesno, ftsol,fqsol,fsnow, ruis)
2244c
2245      DO i = 1, klon
2246         zxqsol(i) = 0.0
2247         zxsnow(i) = 0.0
2248      ENDDO
2249      DO nsrf = 1, nbsrf
2250      DO i = 1, klon
2251         zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2252         zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2253      ENDDO
2254      ENDDO
2255c
2256c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2257c
2258c$$$      DO nsrf = 1, nbsrf
2259c$$$      DO i = 1, klon
2260c$$$         IF (pctsrf(i,nsrf).LT.epsfra) THEN
2261c$$$            fqsol(i,nsrf) = zxqsol(i)
2262c$$$            fsnow(i,nsrf) = zxsnow(i)
2263c$$$         ENDIF
2264c$$$      ENDDO
2265c$$$      ENDDO
2266c
2267c Calculer le bilan du sol et la derive de temperature (couplage)
2268c
2269      DO i = 1, klon
2270         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2271      ENDDO
2272c
2273cmoddeblott(jan95)
2274c Appeler le programme de parametrisation de l'orographie
2275c a l'echelle sous-maille:
2276c
2277      IF (ok_orodr) THEN
2278c
2279c  selection des points pour lesquels le shema est actif:
2280        igwd=0
2281        DO i=1,klon
2282        itest(i)=0
2283c        IF ((zstd(i).gt.10.0)) THEN
2284        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2285          itest(i)=1
2286          igwd=igwd+1
2287          idx(igwd)=i
2288        ENDIF
2289        ENDDO
2290c        igwdim=MAX(1,igwd)
2291c
2292        CALL drag_noro(klon,klev,dtime,paprs,pplay,
2293     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
2294     e                   igwd,idx,itest,
2295     e                   t_seri, u_seri, v_seri,
2296     s                   zulow, zvlow, zustr, zvstr,
2297     s                   d_t_oro, d_u_oro, d_v_oro)
2298c
2299c  ajout des tendances
2300        DO k = 1, klev
2301        DO i = 1, klon
2302           t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2303           u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2304           v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2305        ENDDO
2306        ENDDO
2307c
2308      ENDIF ! fin de test sur ok_orodr
2309c
2310      IF (ok_orolf) THEN
2311c
2312c  selection des points pour lesquels le shema est actif:
2313        igwd=0
2314        DO i=1,klon
2315        itest(i)=0
2316        IF ((zpic(i)-zmea(i)).GT.100.) THEN
2317          itest(i)=1
2318          igwd=igwd+1
2319          idx(igwd)=i
2320        ENDIF
2321        ENDDO
2322c        igwdim=MAX(1,igwd)
2323c
2324        CALL lift_noro(klon,klev,dtime,paprs,pplay,
2325     e                   rlat,zmea,zstd,zpic,
2326     e                   itest,
2327     e                   t_seri, u_seri, v_seri,
2328     s                   zulow, zvlow, zustr, zvstr,
2329     s                   d_t_lif, d_u_lif, d_v_lif)
2330c
2331c  ajout des tendances
2332        DO k = 1, klev
2333        DO i = 1, klon
2334           t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2335           u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2336           v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2337        ENDDO
2338        ENDDO
2339c
2340      ENDIF ! fin de test sur ok_orolf
2341c
2342cAA
2343cAA Installation de l'interface online-offline pour traceurs
2344cAA
2345c====================================================================
2346c   Calcul  des tendances traceurs
2347c====================================================================
2348C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2349cKE43       des traceurs => il faut donc mettre des flags a .false.
2350      IF (iflag_con.EQ.4) THEN
2351c           on ajoute les tendances calculees par KE43
2352c$$$ OM on onhibe la convection sur les traceurs
2353        DO iq=1, nqmax-2 ! Sandrine a -3 ???
2354c$$$ OM on inhibe la convection sur les traceur
2355c$$$        DO k = 1, nlev
2356c$$$        DO i = 1, klon
2357c$$$          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2358c$$$        ENDDO
2359c$$$        ENDDO
2360        WRITE(iqn,'(i2.2)') iq
2361        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2362        ENDDO
2363CMAF modif pour garder info du nombre de traceurs auxquels
2364C la physique s'applique
2365      ELSE
2366CMAF modif pour garder info du nombre de traceurs auxquels
2367C la physique s'applique
2368C
2369      call phytrac (rnpb,
2370     I                   debut,lafin,
2371     I                   nqmax-2,
2372     I                   nlon,nlev,dtime,
2373     I                   t,paprs,pplay,
2374     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2375     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2376     I                   frac_impa, frac_nucl,
2377     I                   rlon,presnivs,paire,pphis,
2378     O                   tr_seri)
2379      ENDIF
2380
2381      IF (offline) THEN
2382
2383         call phystokenc (
2384     I                   nlon,nlev,pdtphys,rlon,rlat,
2385     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2386     I                   ycoefh,yu1,yv1,ftsol,pctsrf,
2387     I                   frac_impa, frac_nucl,
2388     I                   pphis,paire,dtime,itap)
2389
2390
2391      ENDIF
2392
2393c
2394c Calculer le transport de l'eau et de l'energie (diagnostique)
2395c
2396      CALL transp (paprs,zxtsol,
2397     e                   t_seri, q_seri, u_seri, v_seri, zphi,
2398     s                   ve, vq, ue, uq)
2399c
2400c Accumuler les variables a stocker dans les fichiers histoire:
2401c
2402c
2403c
2404
2405      IF (ok_journe) THEN
2406c
2407      ndex2d = 0
2408      ndex3d = 0
2409c
2410c Champs 2D:
2411c
2412         zsto = dtime
2413         zout = dtime * FLOAT(ecrit_day)
2414
2415         i = NINT(zout/zsto)
2416         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2417         CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2418         varname = 'phis'
2419         vartitle= 'Surface geop. height'
2420         varunits= '-'
2421c        call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2422c    .                                                    varunits)
2423c
2424         i = NINT(zout/zsto)
2425         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2426         CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2427         varname = 'aire'
2428         vartitle= 'Grid area'
2429         varunits= '-'
2430c        call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2431c    .                                                    varunits)
2432C
2433      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2434      CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2435c     call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2436c    .              'Surface Temperature','K')
2437c
2438C
2439      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2440      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2441      CALL histwrite(nid_day,"tter",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2442c     call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2443c    .              'Surface Temperature','K')
2444C
2445      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2446      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2447      CALL histwrite(nid_day,"tlic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2448c     call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2449c    .              'Surface Temperature','K')
2450C
2451      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2452      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2453      CALL histwrite(nid_day,"toce",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2454c     call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2455c    .              'Surface Temperature','K')
2456C
2457      zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2458      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2459      CALL histwrite(nid_day,"tsic",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2460c     call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2461c    .              'Surface Temperature','K')
2462C
2463      DO i = 1, klon
2464         zx_tmp_fi2d(i) = paprs(i,1)
2465      ENDDO
2466      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2467      CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2468c Essai writephys
2469      varname = 'psol'
2470      vartitle= 'pression au sol'
2471      varunits= 'hPa'
2472c     call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2473c    .                                                    varunits)
2474c
2475      DO i = 1, klon
2476         zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2477      ENDDO
2478      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2479      CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2480c     call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2481c    .              'Precipitation','mm/day')
2482
2483
2484c
2485      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2486      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2487c     call writephy(fid_day,prof2d_av,'snow',snow_fall,
2488c    .              'Snow','mm/day')
2489c
2490      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2491      CALL histwrite(nid_day,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2492c     call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2493c    .              'Snow cover','mm')
2494c
2495      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2496      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2497c     call writephy(fid_day,prof2d_av,'evap',evap,
2498c    .              'Evaporation','mm/day')
2499c
2500      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2501      CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2502c     call writephy(fid_day,prof2d_av,'tops',topsw,
2503c    .              'Solar rad. at TOA','W/m2')
2504c
2505      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2506      CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2507c     call writephy(fid_day,prof2d_av,'topl',toplw,
2508c    .              'IR rad. at TOA','W/m2')
2509c
2510      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2511      CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2512c     call writephy(fid_day,prof2d_av,'sols',solsw,
2513c    .              'Solar rad. at surf.','W/m2')
2514c
2515      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2516      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2517c     call writephy(fid_day,prof2d_av,'soll',sollw,
2518c    .              'IR rad. at surface','W/m2')
2519c
2520      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2521      CALL histwrite(nid_day,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2522c     call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2523c    .              'Down. IR rad. at surface','W/m2')
2524c
2525      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2526      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2527c     call writephy(fid_day,prof2d_av,'bils',bils,
2528c    .              'Surf. total heat flux','W/m2')
2529c
2530      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2531      CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2532c     call writephy(fid_day,prof2d_av,'sens',sens,
2533c    .              'Sensible heat flux','W/m2')
2534c
2535      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2536      CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2537c     call writephy(fid_day,prof2d_av,'fder',fder,
2538c    .              'Heat flux derivation','W/m2')
2539c
2540c
2541      DO nsrf = 1, nbsrf
2542C§§§
2543        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2544        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2545        CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itap,
2546     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2547c       call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2548c    .                pctsrf( 1 : klon, nsrf),
2549c    .                'Fraction'//clnsurf(nsrf),'-')
2550C
2551        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2552        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2553        CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itap,
2554     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2555c       call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2556c    .                ftsol( 1 : klon, nsrf),
2557c    .                'Surf. Temp'//clnsurf(nsrf),'K')
2558C
2559        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2560        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2561        CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itap,
2562     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2563c       call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2564c    .                fluxt( 1 : klon, 1, nsrf),
2565c    .                'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2566
2567        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2568        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2569        CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itap,
2570     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2571c       call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2572c    .                fluxlat( 1 : klon, nsrf),
2573c    .                'Latent heat flux '//clnsurf(nsrf),'W/m2')
2574C
2575        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2576        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2577        CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itap,
2578     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2579c       call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2580c    .                fluxu( 1 : klon, 1, nsrf),
2581c    .                'Zonal wind stress '//clnsurf(nsrf),'Pa')
2582C     
2583        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2584        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2585        CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itap,
2586     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2587c       call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2588c    .                fluxv( 1 : klon, 1, nsrf),
2589c    .                'Meridional wind stress '//clnsurf(nsrf),'Pa')
2590C
2591        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2592        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2593        CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itap,
2594     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2595c       call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2596c    .                falbe( 1 : klon, nsrf),
2597c    .                'Albedo surf. SW'//clnsurf(nsrf),'-')
2598c       call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2599c    .                falblw( 1 : klon, nsrf),
2600c    .                'Albedo surf. LW'//clnsurf(nsrf),'-')
2601C
2602        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2603        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2604        CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itap,
2605     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2606c       call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2607c    .                frugs( 1 : klon, nsrf),
2608c    .                'Rugosity '//clnsurf(nsrf),' - ')
2609C
2610      END DO 
2611C
2612c$$$      DO i = 1, klon
2613c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2614c$$$      ENDDO
2615c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2616c$$$      CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2617c
2618      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2619      CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2620c     call writephy(fid_day,prof2d_av,'cldl',cldl,
2621c    .              'Low-level cloudiness','-')
2622c
2623      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2624      CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2625c     call writephy(fid_day,prof2d_av,'cldm',cldm,
2626c    .              'Mid-level cloudiness','-')
2627c
2628      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2629      CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2630c     call writephy(fid_day,prof2d_av,'cldh',cldh,
2631c    .              'High-level cloudiness','-')
2632c
2633      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2634      CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2635c     call writephy(fid_day,prof2d_av,'cldt',cldt,
2636c    .              'Total cloudiness','-')
2637c
2638      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2639      CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2640c     call writephy(fid_day,prof2d_av,'cldq',cldq,
2641c    .              'Cloud liquid water path','-')
2642c
2643c Champs 3D:
2644c
2645      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2646      CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
2647     .                                   iim*jjmp1*klev,ndex3d)
2648c Essai writephys
2649      varname = 'temp'
2650      vartitle= 'temperature 3D'
2651      varunits= 'K'
2652c     call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2653c
2654      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2655      CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
2656     .                                   iim*jjmp1*klev,ndex3d)
2657c     call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2658c    .              'Specific humidity','Kg/Kg')
2659c
2660      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2661      CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
2662     .                                   iim*jjmp1*klev,ndex3d)
2663c     call writephy(fid_day,prof3d_av,'geop',zphi,
2664c    .              'Geopotential height','m')
2665c
2666      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2667      CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
2668     .                                   iim*jjmp1*klev,ndex3d)
2669c     call writephy(fid_day,prof3d_av,'vitu',u_seri,
2670c    .              'Zonal wind','m/s')
2671c
2672      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2673      CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
2674     .                                   iim*jjmp1*klev,ndex3d)
2675c     call writephy(fid_day,prof3d_av,'vitv',v_seri,
2676c    .              'Meridional wind','m/s')
2677c
2678      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2679      CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
2680     .                                   iim*jjmp1*klev,ndex3d)
2681c     call writephy(fid_day,prof3d_av,'vitw',omega,
2682c    .              'Vertical wind','m/s')
2683c
2684      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2685      CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
2686     .                                   iim*jjmp1*klev,ndex3d)
2687c     call writephy(fid_day,prof3d_av,'pres',pplay,
2688c    .              'Air pressure','Pa')
2689
2690c
2691      if (ok_sync) then
2692c       call writephy_sync(fid_day)
2693        call histsync(nid_day)
2694      endif
2695      ENDIF
2696C
2697      IF (ok_mensuel) THEN
2698c
2699      ndex2d = 0
2700      ndex3d = 0
2701c
2702c Champs 2D:
2703c
2704         zsto = dtime
2705         zout = dtime * ecrit_mth
2706
2707         i = NINT(zout/zsto)
2708         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2709         CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2710C
2711         i = NINT(zout/zsto)
2712         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2713         CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
2714
2715      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2716      CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2717c
2718      DO i = 1, klon
2719         zx_tmp_fi2d(i) = paprs(i,1)
2720      ENDDO
2721      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2722      CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2723c
2724      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2725      CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2726c
2727      DO i = 1, klon
2728         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2729      ENDDO
2730      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2731      CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2732c
2733      DO i = 1, klon
2734         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2735      ENDDO
2736      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2737      CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2738c
2739      DO i = 1, klon
2740         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2741      ENDDO
2742      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2743      CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2744c
2745      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2746      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2747c
2748      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2749      CALL histwrite(nid_mth,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2750c
2751      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2752      CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2753c
2754      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2755      CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2756c
2757      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2758      CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2759c
2760      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2761      CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2762c
2763      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2764      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2765c
2766      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2767      CALL histwrite(nid_mth,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2768c
2769      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2770      CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2771c
2772      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2773      CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2774c
2775      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2776      CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2777c
2778      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2779      CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2780c
2781      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2782      CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2783c
2784      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2785      CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2786c
2787      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2788      CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2789c
2790c
2791c      DO i = 1, klon
2792c         zx_tmp_fi2d(i) = fluxu(i,1)
2793c      ENDDO
2794c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2795c      CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2796c
2797c      DO i = 1, klon
2798c         zx_tmp_fi2d(i) = fluxv(i,1)
2799c      ENDDO
2800c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2801c      CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2802c
2803      DO nsrf = 1, nbsrf
2804C§§§
2805        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2806        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2807        CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itap,
2808     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2809C
2810        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2811        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2812        CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itap,
2813     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2814C
2815        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2816        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2817        CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itap,
2818     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2819C
2820        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2821        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2822        CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itap,
2823     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2824C
2825        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2826        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2827        CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itap,
2828     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2829C     
2830        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2831        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2832        CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itap,
2833     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2834C
2835        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2836        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2837        CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itap,
2838     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2839C
2840        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2841        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2842        CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itap,
2843     $      zx_tmp_2d,iim*jjmp1,ndex2d)
2844c
2845      zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2846      CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2847      CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itap
2848     $    ,zx_tmp_2d,iim*jjmp1,ndex2d)
2849
2850      END DO 
2851c$$$      DO i = 1, klon
2852c$$$         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2853c$$$      ENDDO
2854c$$$      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2855c$$$      CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2856c
2857      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2858      CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2859      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2860      CALL histwrite(nid_mth,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2861c
2862      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2863      CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2864c
2865      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2866      CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2867c
2868      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2869      CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2870c
2871      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2872      CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2873c
2874      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2875      CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2876c
2877      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2878      CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2879c
2880      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2881      CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2882c
2883      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
2884      CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2885c
2886      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
2887      CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2888c
2889      CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
2890      CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2891c
2892      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
2893      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2894cKE43
2895      IF (iflag_con .EQ. 4) THEN ! sb
2896c
2897      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
2898      CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2899c
2900      CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
2901      CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2902c
2903      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
2904      CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2905c
2906      CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
2907      CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
2908c
2909c
2910      ENDIF
2911c34EK
2912c
2913c Champs 3D:
2914C
2915      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2916      CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
2917     .                                   iim*jjmp1*klev,ndex3d)
2918c
2919      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2920      CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
2921     .                                   iim*jjmp1*klev,ndex3d)
2922c
2923      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2924      CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
2925     .                                   iim*jjmp1*klev,ndex3d)
2926c
2927      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2928      CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
2929     .                                   iim*jjmp1*klev,ndex3d)
2930c
2931      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2932      CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
2933     .                                   iim*jjmp1*klev,ndex3d)
2934c
2935      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2936      CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
2937     .                                   iim*jjmp1*klev,ndex3d)
2938c
2939      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2940      CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
2941     .                                   iim*jjmp1*klev,ndex3d)
2942c
2943      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
2944      CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
2945     .                                   iim*jjmp1*klev,ndex3d)
2946c
2947      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
2948      CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
2949     .                                   iim*jjmp1*klev,ndex3d)
2950c
2951      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
2952      CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
2953     .                                   iim*jjmp1*klev,ndex3d)
2954c
2955      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
2956      CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
2957     .                                   iim*jjmp1*klev,ndex3d)
2958c
2959      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
2960      CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
2961     .                                   iim*jjmp1*klev,ndex3d)
2962c
2963      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
2964      CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
2965     .                                   iim*jjmp1*klev,ndex3d)
2966c
2967      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
2968      CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
2969     .                                   iim*jjmp1*klev,ndex3d)
2970c
2971      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
2972      CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
2973     .                                   iim*jjmp1*klev,ndex3d)
2974c
2975      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
2976      CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
2977     .                                   iim*jjmp1*klev,ndex3d)
2978c
2979      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
2980      CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
2981     .                                   iim*jjmp1*klev,ndex3d)
2982c
2983      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
2984      CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
2985     .                                   iim*jjmp1*klev,ndex3d)
2986c
2987      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
2988      CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
2989     .                                   iim*jjmp1*klev,ndex3d)
2990c
2991      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
2992      CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
2993     .                                   iim*jjmp1*klev,ndex3d)
2994c
2995      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
2996      CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d,
2997     .                                   iim*(jjm+1)*klev,ndex3d)
2998c
2999      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
3000      CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d,
3001     .                                   iim*(jjm+1)*klev,ndex3d)
3002c
3003      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
3004      CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
3005     .                                   iim*jjmp1*klev,ndex3d)
3006c
3007      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
3008      CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
3009     .                                   iim*jjmp1*klev,ndex3d)
3010c
3011      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
3012      CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
3013     .                                   iim*jjmp1*klev,ndex3d)
3014c
3015      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
3016      CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
3017     .                                   iim*jjmp1*klev,ndex3d)
3018c
3019      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3020      CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
3021     .                                   iim*jjmp1*klev,ndex3d)
3022c
3023      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3024      CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
3025     .                                   iim*jjmp1*klev,ndex3d)
3026c
3027      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3028      CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
3029     .                                   iim*jjmp1*klev,ndex3d)
3030c
3031      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3032      CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
3033     .                                   iim*jjmp1*klev,ndex3d)
3034c
3035      IF (ok_orodr) THEN
3036      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3037      CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
3038     .                                   iim*jjmp1*klev,ndex3d)
3039c
3040      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3041      CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
3042     .                                   iim*jjmp1*klev,ndex3d)
3043c
3044      ENDIF
3045C
3046      IF (ok_orolf) THEN
3047      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3048      CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
3049     .                                   iim*jjmp1*klev,ndex3d)
3050c
3051      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3052      CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
3053     .                                   iim*jjmp1*klev,ndex3d)
3054      ENDIF
3055C
3056      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3057      CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
3058     .                                   iim*jjmp1*klev,ndex3d)
3059c
3060      IF (nqmax.GE.3) THEN
3061      DO iq=1,nqmax-2
3062      IF (iq.LE.99) THEN
3063         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3064         WRITE(str2,'(i2.2)') iq
3065         CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
3066     .                                   iim*jjmp1*klev,ndex3d)
3067      ELSE
3068         PRINT*, "Trop de traceurs"
3069         CALL abort
3070      ENDIF
3071      ENDDO
3072      ENDIF
3073cKE43
3074      IF (iflag_con.EQ.4) THEN ! (sb)
3075c
3076      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3077      CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d,
3078     .                                   iim*jjmp1*klev,ndex3d)
3079c
3080      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3081      CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d,
3082     .                                   iim*jjmp1*klev,ndex3d)
3083c
3084      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3085      CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d,
3086     .                                   iim*jjmp1*klev,ndex3d)
3087c
3088      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3089      CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d,
3090     .                                   iim*jjmp1*klev,ndex3d)
3091c
3092c
3093      ENDIF
3094c34EK
3095c
3096      if (ok_sync) then
3097        call histsync(nid_mth)
3098      endif
3099      ENDIF
3100c
3101      IF (ok_instan) THEN
3102c
3103      ndex2d = 0
3104      ndex3d = 0
3105c
3106c Champs 2D:
3107c
3108         zsto = dtime * ecrit_ins
3109         zout = dtime * ecrit_ins
3110
3111         i = NINT(zout/zsto)
3112         CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3113         CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3114c
3115         i = NINT(zout/zsto)
3116         CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3117         CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
3118
3119      DO i = 1, klon
3120         zx_tmp_fi2d(i) = paprs(i,1)
3121      ENDDO
3122      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3123      CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3124c
3125      DO i = 1, klon
3126         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3127      ENDDO
3128      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3129      CALL histwrite(nid_ins,"rain",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3130c
3131      DO i = 1, klon
3132         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3133      ENDDO
3134      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3135      CALL histwrite(nid_ins,"plul",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3136c
3137      DO i = 1, klon
3138         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3139      ENDDO
3140      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3141      CALL histwrite(nid_ins,"pluc",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3142
3143      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3144      CALL histwrite(nid_ins,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3145c
3146      CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3147      CALL histwrite(nid_ins,"snow",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3148
3149c
3150      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3151      CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3152c
3153      CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3154      CALL histwrite(nid_ins,"evap",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3155c
3156      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3157      CALL histwrite(nid_ins,"sols",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3158c
3159      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3160      CALL histwrite(nid_ins,"soll",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3161c
3162      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3163      CALL histwrite(nid_ins,"solldown",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3164c
3165      CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3166      CALL histwrite(nid_ins,"bils",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3167c
3168      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3169      CALL histwrite(nid_ins,"sens",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3170c
3171      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3172      CALL histwrite(nid_ins,"fder",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3173c
3174      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3175      CALL histwrite(nid_ins,"dtsvdfo",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3176c
3177      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3178      CALL histwrite(nid_ins,"dtsvdft",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3179c
3180      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3181      CALL histwrite(nid_ins,"dtsvdfg",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3182c
3183      CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3184      CALL histwrite(nid_ins,"dtsvdfi",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3185
3186      DO nsrf = 1, nbsrf
3187C§§§
3188        zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3189        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3190        CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itap,
3191     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3192C
3193        zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3194        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3195        CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itap,
3196     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3197C
3198        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3199        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3200        CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itap,
3201     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3202C
3203        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3204        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3205        CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itap,
3206     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3207C
3208        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3209        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3210        CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itap,
3211     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3212C     
3213        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3214        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3215        CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itap,
3216     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3217C
3218        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3219        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3220        CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itap,
3221     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3222C
3223        zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3224        CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3225        CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itap,
3226     $      zx_tmp_2d,iim*jjmp1,ndex2d)
3227C
3228      END DO 
3229      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3230      CALL histwrite(nid_ins,"albs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3231      CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3232      CALL histwrite(nid_ins,"albslw",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3233c
3234      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3235      CALL histwrite(nid_ins,"snow_cov",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3236c
3237      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3238      CALL histwrite(nid_ins,"rugs",itap,zx_tmp_2d,iim*jjmp1,ndex2d)
3239c
3240c Champs 3D:
3241c
3242      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3243      CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
3244     .                                   iim*jjmp1*klev,ndex3d)
3245c
3246      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3247      CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
3248     .                                   iim*jjmp1*klev,ndex3d)
3249c
3250      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3251      CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
3252     .                                   iim*jjmp1*klev,ndex3d)
3253c
3254      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3255      CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
3256     .                                   iim*jjmp1*klev,ndex3d)
3257c
3258      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3259      CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
3260     .                                   iim*jjmp1*klev,ndex3d)
3261c
3262      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3263      CALL histwrite(nid_ins,"dtvdf",itap,zx_tmp_3d,
3264     .                                   iim*jjmp1*klev,ndex3d)
3265c
3266      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3267      CALL histwrite(nid_ins,"dqvdf",itap,zx_tmp_3d,
3268     .                                   iim*jjmp1*klev,ndex3d)
3269
3270c
3271      if (ok_sync) then
3272        call histsync(nid_ins)
3273      endif
3274      ENDIF
3275c
3276c
3277c Ecrire la bande regionale (binaire grads)
3278      IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3279         CALL ecriregs(84,zxtsol)
3280         CALL ecriregs(84,paprs(1,1))
3281         CALL ecriregs(84,topsw)
3282         CALL ecriregs(84,toplw)
3283         CALL ecriregs(84,solsw)
3284         CALL ecriregs(84,sollw)
3285         CALL ecriregs(84,rain_fall)
3286         CALL ecriregs(84,snow_fall)
3287         CALL ecriregs(84,evap)
3288         CALL ecriregs(84,sens)
3289         CALL ecriregs(84,bils)
3290         CALL ecriregs(84,pctsrf(1,is_sic))
3291         CALL ecriregs(84,zxfluxu(1,1))
3292         CALL ecriregs(84,zxfluxv(1,1))
3293         CALL ecriregs(84,ue)
3294         CALL ecriregs(84,ve)
3295         CALL ecriregs(84,uq)
3296         CALL ecriregs(84,vq)
3297c
3298         CALL ecrirega(84,u_seri)
3299         CALL ecrirega(84,v_seri)
3300         CALL ecrirega(84,omega)
3301         CALL ecrirega(84,t_seri)
3302         CALL ecrirega(84,zphi)
3303         CALL ecrirega(84,q_seri)
3304         CALL ecrirega(84,cldfra)
3305         CALL ecrirega(84,cldliq)
3306         CALL ecrirega(84,pplay)
3307
3308
3309cc         CALL ecrirega(84,d_t_dyn)
3310cc         CALL ecrirega(84,d_q_dyn)
3311cc         CALL ecrirega(84,heat)
3312cc         CALL ecrirega(84,cool)
3313cc         CALL ecrirega(84,d_t_con)
3314cc         CALL ecrirega(84,d_q_con)
3315cc         CALL ecrirega(84,d_t_lsc)
3316cc         CALL ecrirega(84,d_q_lsc)
3317      ENDIF
3318c
3319c Convertir les incrementations en tendances
3320c
3321      DO k = 1, klev
3322      DO i = 1, klon
3323         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3324         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3325         d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3326         d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3327         d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3328      ENDDO
3329      ENDDO
3330c
3331      IF (nqmax.GE.3) THEN
3332      DO iq = 3, nqmax
3333      DO  k = 1, klev
3334      DO  i = 1, klon
3335         d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3336      ENDDO
3337      ENDDO
3338      ENDDO
3339      ENDIF
3340c
3341c Sauvegarder les valeurs de t et q a la fin de la physique:
3342c
3343      DO k = 1, klev
3344      DO i = 1, klon
3345         t_ancien(i,k) = t_seri(i,k)
3346         q_ancien(i,k) = q_seri(i,k)
3347      ENDDO
3348      ENDDO
3349c
3350c====================================================================
3351c Si c'est la fin, il faut conserver l'etat de redemarrage
3352c====================================================================
3353c
3354      IF (lafin) THEN
3355ccc         IF (ok_oasis) CALL quitcpl
3356         CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3357     .      rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3358     .      falbe, fevap, rain_fall, snow_fall,
3359     .      solsw, sollwdown,dlw,
3360     .      radsol,frugs,agesno,
3361     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3362     .      t_ancien, q_ancien)
3363      ENDIF
3364
3365      RETURN
3366      END
3367      FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3368      IMPLICIT none
3369c
3370c Calculer et imprimer l'eau totale. A utiliser pour verifier
3371c la conservation de l'eau
3372c
3373#include "YOMCST.h"
3374      INTEGER klon,klev
3375      REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3376      REAL aire(klon)
3377      REAL qtotal, zx, qcheck
3378      INTEGER i, k
3379c
3380      zx = 0.0
3381      DO i = 1, klon
3382         zx = zx + aire(i)
3383      ENDDO
3384      qtotal = 0.0
3385      DO k = 1, klev
3386      DO i = 1, klon
3387         qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3388     .                     *(paprs(i,k)-paprs(i,k+1))/RG
3389      ENDDO
3390      ENDDO
3391c
3392      qcheck = qtotal/zx
3393c
3394      RETURN
3395      END
3396      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3397      IMPLICIT none
3398c
3399c Tranformer une variable de la grille physique a
3400c la grille d'ecriture
3401c
3402      INTEGER nfield,nlon,iim,jjmp1, jjm
3403      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3404c
3405      INTEGER i, n, ig
3406c
3407      jjm = jjmp1 - 1
3408      DO n = 1, nfield
3409         DO i=1,iim
3410            ecrit(i,n) = fi(1,n)
3411            ecrit(i+jjm*iim,n) = fi(nlon,n)
3412         ENDDO
3413         DO ig = 1, nlon - 2
3414           ecrit(iim+ig,n) = fi(1+ig,n)
3415         ENDDO
3416      ENDDO
3417      RETURN
3418      END
3419
Note: See TracBrowser for help on using the repository browser.