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

Last change on this file since 180 was 179, checked in by lmdzadmin, 24 years ago

Synchronisation avec version MAFO:

ajout sortie netcdf des champs echanges avec le coupleur
quelques save sur les variables (pb stack/static sur le nec)

LF

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