/[lmdze]/trunk/phylmd/physiq.f
ViewVC logotype

Diff of /trunk/phylmd/physiq.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &
14         d_t, d_qx, d_ps, dudyn, PVteta)         d_t, d_qx, d_ps, dudyn, PVteta)
15    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
17    
18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18
19    
# Line 23  contains Line 23  contains
23      !AA                  -  stockage des moyennes des champs necessaires      !AA                  -  stockage des moyennes des champs necessaires
24      !AA                     en mode traceur off-line      !AA                     en mode traceur off-line
25    
     USE ioipsl, only: ymds2ju, histwrite, histsync  
     use dimens_m, only: jjm, iim, llm  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline, iphysiq  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref, itaufin  
     use clesphys, only: ecrit_hf, ecrit_hf2mth, &  
          ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &  
          nbapp_rad, cycle_diurne, cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &  
          ok_kzmin, soil_model  
     use iniprint, only: lunout, prt_level  
26      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
27      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE calendar, only: ymds2ju
28        use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
29             cdmmax, cdhmax, &
30             co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
31             ok_kzmin
32        use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
33             cycle_diurne, new_oliq, soil_model
34        use clmain_m, only: clmain
35      use comgeomphy      use comgeomphy
36        use conf_gcm_m, only: raz_date, offline
37        use conf_phys_m, only: conf_phys
38      use ctherm      use ctherm
39      use phytrac_m, only: phytrac      use dimens_m, only: jjm, iim, llm, nqmx
40        use dimphy, only: klon, nbtr
41        use dimsoil, only: nsoilmx
42        use hgardfou_m, only: hgardfou
43        USE histcom, only: histsync
44        USE histwrite_m, only: histwrite
45        use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
46             clnsurf, epsfra
47        use ini_histhf_m, only: ini_histhf
48        use ini_histday_m, only: ini_histday
49        use ini_histins_m, only: ini_histins
50        use iniprint, only: prt_level
51      use oasis_m      use oasis_m
     use radepsi  
     use radopt  
     use yoethf  
     use ini_hist, only: ini_histhf, ini_histday, ini_histins  
52      use orbite_m, only: orbite, zenang      use orbite_m, only: orbite, zenang
53        use ozonecm_m, only: ozonecm
54      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
55      use hgardfou_m, only: hgardfou      use phyredem_m, only: phyredem
56      use conf_phys_m, only: conf_phys      use phystokenc_m, only: phystokenc
57        use phytrac_m, only: phytrac
58        use qcheck_m, only: qcheck
59        use radepsi
60        use radopt
61        use temps, only: itau_phy, day_ref, annee_ref
62        use yoethf_m
63        use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
64    
65      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
66      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
67    
68      ! Variables argument:      ! Variables argument:
69    
70      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      REAL, intent(in):: rdayvrai
71      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience      ! (elapsed time since January 1st 0h of the starting year, in days)
72    
73      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
74      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
75      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
76    
77      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
78      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
79        
80      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
81      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
82    
83      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 75  contains Line 85  contains
85    
86      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
87    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
88      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s
89      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL, intent(in):: v(klon, llm)  ! vitesse Y (de S a N) en m/s
90      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
91    
92      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nqmx)
93      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
94    
95      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
96      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
97      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)
98      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)
99      REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)
100      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon)  ! output tendance physique de la pression au sol
101    
102        LOGICAL:: firstcal = .true.
103    
104      INTEGER nbteta      INTEGER nbteta
105      PARAMETER(nbteta=3)      PARAMETER(nbteta=3)
106    
# Line 112  contains Line 121  contains
121      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
122      logical rnpb      logical rnpb
123      parameter(rnpb=.true.)      parameter(rnpb=.true.)
124      !      ocean = type de modele ocean a utiliser: force, slab, couple  
125      character(len=6) ocean      character(len=6), save:: ocean
126      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
127    
128      logical ok_ocean      logical ok_ocean
129      SAVE ok_ocean      SAVE ok_ocean
# Line 128  contains Line 137  contains
137      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
138    
139      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
140      logical ok_veget      logical, save:: ok_veget
141      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
142    
143      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
144    
# Line 178  contains Line 185  contains
185      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
186      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
187    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
188      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
189      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
190      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
191    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
192      !IM Amip2      !IM Amip2
193      ! variables a une pression donnee      ! variables a une pression donnee
194    
# Line 204  contains Line 203  contains
203           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
204           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
205    
     real tlevSTD(klon, nlevSTD), qlevSTD(klon, nlevSTD)  
     real rhlevSTD(klon, nlevSTD), philevSTD(klon, nlevSTD)  
     real ulevSTD(klon, nlevSTD), vlevSTD(klon, nlevSTD)  
     real wlevSTD(klon, nlevSTD)  
   
     ! nout : niveau de output des variables a une pression donnee  
     INTEGER nout  
     PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC  
   
     REAL tsumSTD(klon, nlevSTD, nout)  
     REAL usumSTD(klon, nlevSTD, nout), vsumSTD(klon, nlevSTD, nout)  
     REAL wsumSTD(klon, nlevSTD, nout), phisumSTD(klon, nlevSTD, nout)  
     REAL qsumSTD(klon, nlevSTD, nout), rhsumSTD(klon, nlevSTD, nout)  
   
     SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,  &  
          qsumSTD, rhsumSTD  
   
     logical oknondef(klon, nlevSTD, nout)  
     real tnondef(klon, nlevSTD, nout)  
     save tnondef  
   
     ! les produits uvSTD, vqSTD, .., T2STD sont calcules  
     ! a partir des valeurs instantannees toutes les 6 h  
     ! qui sont moyennees sur le mois  
   
     real uvSTD(klon, nlevSTD)  
     real vqSTD(klon, nlevSTD)  
     real vTSTD(klon, nlevSTD)  
     real wqSTD(klon, nlevSTD)  
   
     real uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
     real vphisumSTD(klon, nlevSTD, nout)  
     real wTsumSTD(klon, nlevSTD, nout)  
     real u2sumSTD(klon, nlevSTD, nout)  
     real v2sumSTD(klon, nlevSTD, nout)  
     real T2sumSTD(klon, nlevSTD, nout)  
   
     SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD  
     SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD  
     !MI Amip2  
   
206      ! prw: precipitable water      ! prw: precipitable water
207      real prw(klon)      real prw(klon)
208    
# Line 263  contains Line 211  contains
211      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
212      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
213    
214      INTEGER l, kmax, lmax      INTEGER kmax, lmax
215      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
216      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
217      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 315  contains Line 263  contains
263      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
264      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
265    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles      )  
   
266      ! Variables propres a la physique      ! Variables propres a la physique
267    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
268      INTEGER, save:: radpas      INTEGER, save:: radpas
269      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
270      ! "physiq".)      ! "physiq".)
# Line 331  contains Line 273  contains
273      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
274    
275      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
276    
277      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
278      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 359  contains Line 299  contains
299      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
300      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
301    
302      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
303        REAL, save:: zmea(klon) ! orographie moyenne
304      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
305      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
306        REAL, save:: zgam(klon) ! anisotropie de l'OESM
307      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
308      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
309        REAL, save:: zval(klon) ! Minimum de l'OESM
310      REAL zsig(klon)      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
     SAVE zsig                   ! pente de l'OESM  
   
     REAL zgam(klon)  
     save zgam                   ! anisotropie de l'OESM  
   
     REAL zthe(klon)  
     SAVE zthe                   ! orientation de l'OESM  
   
     REAL zpic(klon)  
     SAVE zpic                   ! Maximum de l'OESM  
   
     REAL zval(klon)  
     SAVE zval                   ! Minimum de l'OESM  
   
     REAL rugoro(klon)  
     SAVE rugoro                 ! longueur de rugosite de l'OESM  
311    
312      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
313    
# Line 444  contains Line 368  contains
368      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
369      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
370    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
371      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
372      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
373      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 478  contains Line 399  contains
399      REAL albsollw(klon)      REAL albsollw(klon)
400      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
401    
402      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
403    
404      ! Declaration des procedures appelees      ! Declaration des procedures appelees
405    
406      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc     ! calculer l'albedo sur ocean
407      EXTERNAL ajsec     ! ajustement sec      EXTERNAL ajsec     ! ajustement sec
     EXTERNAL clmain    ! couche limite  
408      !KE43      !KE43
409      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
410      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
411      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
412      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
413      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
414    
     EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression  
   
     EXTERNAL undefSTD  
     ! (somme les valeurs definies d'1 var a 1 niveau de pression)  
   
415      ! Variables locales      ! Variables locales
416    
417      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 646  contains Line 559  contains
559      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
560    
561      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
562      real fact_cldcon      real, save:: fact_cldcon
563      real facttemps      real, save:: facttemps
564      logical ok_newmicro      logical ok_newmicro
565      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
566      real facteur      real facteur
567    
568      integer iflag_cldcon      integer iflag_cldcon
# Line 658  contains Line 570  contains
570    
571      logical ptconv(klon, llm)      logical ptconv(klon, llm)
572    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
573      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
574    
575      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 673  contains Line 581  contains
581    
582      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
583    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
584      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
585      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
586      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
# Line 687  contains Line 589  contains
589      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
590    
591      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
   
592      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
593    
594      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
595    
596      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
597      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 717  contains Line 616  contains
616      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
617      SAVE      ip_ebil      SAVE      ip_ebil
618      DATA      ip_ebil/0/      DATA      ip_ebil/0/
619      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
620      !+jld ec_conser      !+jld ec_conser
621      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique
622      REAL ZRCPD      REAL ZRCPD
# Line 790  contains Line 688  contains
688      SAVE trmb2      SAVE trmb2
689      SAVE trmb3      SAVE trmb3
690    
691        real zmasse(klon, llm)
692        ! (column-density of mass of air in a cell, in kg m-2)
693    
694        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
695    
696      !----------------------------------------------------------------      !----------------------------------------------------------------
697    
698      modname = 'physiq'      modname = 'physiq'
# Line 799  contains Line 702  contains
702         END DO         END DO
703      END IF      END IF
704      ok_sync=.TRUE.      ok_sync=.TRUE.
705      IF (nq  <  2) THEN      IF (nqmx  <  2) THEN
706         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
707         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
708      ENDIF      ENDIF
709    
710      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
711         !  initialiser         !  initialiser
712         u10m(:, :)=0.         u10m=0.
713         v10m(:, :)=0.         v10m=0.
714         t2m(:, :)=0.         t2m=0.
715         q2m(:, :)=0.         q2m=0.
716         ffonte(:, :)=0.         ffonte=0.
717         fqcalving(:, :)=0.         fqcalving=0.
718         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
719         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
720         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 824  contains Line 727  contains
727         solswai(:)=0.         solswai(:)=0.
728         solswad(:)=0.         solswad(:)=0.
729    
730         d_u_con(:, :) = 0.0         d_u_con = 0.0
731         d_v_con(:, :) = 0.0         d_v_con = 0.0
732         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
733         clwcon0(:, :) = 0.0         clwcon0 = 0.0
734         rnebcon(:, :) = 0.0         rnebcon = 0.0
735         clwcon(:, :) = 0.0         clwcon = 0.0
736    
737         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
738         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
739         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
740         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
741         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
742         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
743         therm(:, :)  =0.         therm  =0.
744         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
745         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
746         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
747    
748         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
749    
# Line 858  contains Line 761  contains
761         frugs = 0.         frugs = 0.
762         itap = 0         itap = 0
763         itaprad = 0         itaprad = 0
764         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
765              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
766              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
767              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
768              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
769              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
770              run_off_lic_0)              run_off_lic_0)
771    
772         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
773         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
774    
775         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
776    
777         ! on remet le calendrier a zero         ! on remet le calendrier a zero
778           IF (raz_date) itau_phy = 0
779    
780         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
781    
782         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
783            ok_ocean=.TRUE.            ok_ocean=.TRUE.
784         ENDIF         ENDIF
785    
786         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
787              ok_instan, ok_region )              ok_region)
   
        IF (ABS(dtime-pdtphys).GT.0.001) THEN  
           WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &  
                pdtphys  
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
788    
789         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
790            WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
791            WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
792            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
793            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
794         ENDIF         ENDIF
795         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
796         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
797              ok_cvl              ok_cvl
798    
799         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
800         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
801    
802            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
803    
804            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
805            DO i = 1, klon            DO i = 1, klon
# Line 920  contains Line 811  contains
811         ENDIF         ENDIF
812    
813         IF (ok_orodr) THEN         IF (ok_orodr) THEN
814            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
815            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
816           else
817              rugoro = 0.
818         ENDIF         ENDIF
819    
820         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
821         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
822    
823         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
824         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
825         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
826         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
827         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
828    
829         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
830    
831         npas = 0         npas = 0
832         nexca = 0         nexca = 0
        if (ocean == 'couple') then  
           npas = itaufin/ iphysiq  
           nexca = 86400 / int(dtime)  
           write(lunout, *)' Ocean couple'  
           write(lunout, *)' Valeurs des pas de temps'  
           write(lunout, *)' npas = ', npas  
           write(lunout, *)' nexca = ', nexca  
        endif  
833    
834         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
835    
836         !   Initialisation des sorties         !   Initialisation des sorties
837    
838         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
839         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
840         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
841         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
842         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
843         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 973  contains Line 855  contains
855            d_v(i, k) = 0.0            d_v(i, k) = 0.0
856         ENDDO         ENDDO
857      ENDDO      ENDDO
858      DO iq = 1, nq      DO iq = 1, nqmx
859         DO k = 1, llm         DO k = 1, llm
860            DO i = 1, klon            DO i = 1, klon
861               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
862            ENDDO            ENDDO
863         ENDDO         ENDDO
864      ENDDO      ENDDO
865      da(:, :)=0.      da=0.
866      mp(:, :)=0.      mp=0.
867      phi(:, :, :)=0.      phi(:, :, :)=0.
868    
869      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
# Line 996  contains Line 878  contains
878            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
879         ENDDO         ENDDO
880      ENDDO      ENDDO
881      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
882         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
883      ELSE      ELSE
884         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
885      ENDIF      ENDIF
# Line 1013  contains Line 895  contains
895    
896      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
897         ztit='after dynamic'         ztit='after dynamic'
898         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
899              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
900              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
901         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
902         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1032  contains Line 914  contains
914      IF (ancien_ok) THEN      IF (ancien_ok) THEN
915         DO k = 1, llm         DO k = 1, llm
916            DO i = 1, klon            DO i = 1, klon
917               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtime               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys
918               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtime               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys
919            ENDDO            ENDDO
920         ENDDO         ENDDO
921      ELSE      ELSE
# Line 1064  contains Line 946  contains
946      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
947      if (julien == 0) julien = 360      if (julien == 0) julien = 360
948    
949        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
950    
951      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
952      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
953    
954      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nqmx >= 5) then
955         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
956        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
957           wo = ozonecm(REAL(julien), paprs)
958      ENDIF      ENDIF
959    
960      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1089  contains Line 975  contains
975    
976      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
977         ztit='after reevap'         ztit='after reevap'
978         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
979              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
980              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
981         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
982              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1120  contains Line 1006  contains
1006    
1007      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1008      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1009         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1010         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1011      ELSE      ELSE
1012         rmu0 = -999.999         rmu0 = -999.999
# Line 1149  contains Line 1035  contains
1035    
1036      fder = dlw      fder = dlw
1037    
1038      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
1039        CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1040           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1041           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1042           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1206  contains Line 1093  contains
1093    
1094      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1095         ztit='after clmain'         ztit='after clmain'
1096         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1097              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1098              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1099         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1100              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1310  contains Line 1197  contains
1197      DO k = 1, llm      DO k = 1, llm
1198         DO i = 1, klon         DO i = 1, klon
1199            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1200                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1201            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1202                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1203         ENDDO         ENDDO
1204      ENDDO      ENDDO
1205      IF (check) THEN      IF (check) THEN
1206         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1207         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1208      ENDIF      ENDIF
1209      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1210      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1328  contains Line 1215  contains
1215         DO k = 1, llm         DO k = 1, llm
1216            DO i = 1, klon            DO i = 1, klon
1217               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &
1218                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1219            ENDDO            ENDDO
1220         ENDDO         ENDDO
1221      ENDIF      ENDIF
1222      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1223         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1224      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1225         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1226              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1227              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1228              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1356  contains Line 1243  contains
1243         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1244    
1245         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1246              CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
           CALL concvl (iflag_con, &  
                dtime, paprs, pplay, t_seri, q_seri, &  
1247                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1248                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1249                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1370  contains Line 1255  contains
1255                 da, phi, mp)                 da, phi, mp)
1256    
1257            clwcon0=qcondc            clwcon0=qcondc
1258            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1259         ELSE ! ok_cvl         ELSE ! ok_cvl
1260            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1261            CALL conema3 (dtime, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1262                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1263                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1264                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1385  contains Line 1268  contains
1268                 pbase &                 pbase &
1269                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1270                 , clwcon0)                 , clwcon0)
   
1271         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1272    
1273         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1417  contains Line 1299  contains
1299         ENDDO         ENDDO
1300    
1301         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1302         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1303         call clouds_gno &         call clouds_gno &
1304              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1305      ELSE      ELSE
1306         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1307         stop 1         stop 1
1308      ENDIF      ENDIF
1309    
# Line 1436  contains Line 1318  contains
1318    
1319      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1320         ztit='after convect'         ztit='after convect'
1321         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1322              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1323              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1324         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1325              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1448  contains Line 1330  contains
1330    
1331      IF (check) THEN      IF (check) THEN
1332         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1333         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1334         zx_t = 0.0         zx_t = 0.0
1335         za = 0.0         za = 0.0
1336         DO i = 1, klon         DO i = 1, klon
# Line 1456  contains Line 1338  contains
1338            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1339                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1340         ENDDO         ENDDO
1341         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1342         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1343      ENDIF      ENDIF
1344      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1345         DO i = 1, klon         DO i = 1, klon
# Line 1466  contains Line 1348  contains
1348         DO k = 1, llm         DO k = 1, llm
1349            DO i = 1, klon            DO i = 1, klon
1350               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &
1351                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1352            ENDDO            ENDDO
1353         ENDDO         ENDDO
1354         DO i = 1, klon         DO i = 1, klon
1355            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &
1356                 /z_apres(i)                 /z_apres(i)
1357         ENDDO         ENDDO
1358         DO k = 1, llm         DO k = 1, llm
# Line 1486  contains Line 1368  contains
1368    
1369      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1370    
1371      d_t_ajs(:, :)=0.      d_t_ajs=0.
1372      d_u_ajs(:, :)=0.      d_u_ajs=0.
1373      d_v_ajs(:, :)=0.      d_v_ajs=0.
1374      d_q_ajs(:, :)=0.      d_q_ajs=0.
1375      fm_therm(:, :)=0.      fm_therm=0.
1376      entr_therm(:, :)=0.      entr_therm=0.
1377    
1378      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1379           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1380           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1381      if(iflag_thermals < 0) then      if(iflag_thermals < 0) then
1382         !  Rien         !  Rien
1383         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1384      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1385         !  Ajustement sec         !  Ajustement sec
1386         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1387         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1388         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1389         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1390      else      else
1391         !  Thermiques         !  Thermiques
1392         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1393              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1394         call calltherm(pdtphys &         call calltherm(pdtphys &
1395              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1518  contains Line 1400  contains
1400    
1401      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1402         ztit='after dry_adjust'         ztit='after dry_adjust'
1403         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1404              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1405              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1406      END IF      END IF
1407    
# Line 1555  contains Line 1437  contains
1437         !   1e4 (en gros 3 heures), en dur pour le moment, est le temps de         !   1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1438         !   relaxation des ratqs         !   relaxation des ratqs
1439         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1440         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1441         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1442      else      else
1443         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1444         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1445      endif      endif
1446    
1447      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1448      ! et le processus de precipitation      ! et le processus de precipitation
1449      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1450           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1451           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1452           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1585  contains Line 1467  contains
1467      ENDDO      ENDDO
1468      IF (check) THEN      IF (check) THEN
1469         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1470         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1471         zx_t = 0.0         zx_t = 0.0
1472         za = 0.0         za = 0.0
1473         DO i = 1, klon         DO i = 1, klon
# Line 1593  contains Line 1475  contains
1475            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1476                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1477         ENDDO         ENDDO
1478         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1479         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1480      ENDIF      ENDIF
1481    
1482      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1483         ztit='after fisrt'         ztit='after fisrt'
1484         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1485              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1486              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1487         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1488              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1623  contains Line 1505  contains
1505               do i=1, klon               do i=1, klon
1506                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1507                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1508                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1509                  endif                  endif
1510               enddo               enddo
1511            enddo            enddo
# Line 1659  contains Line 1541  contains
1541         enddo         enddo
1542    
1543         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1544         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1545         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1546    
1547      ENDIF      ENDIF
1548    
# Line 1687  contains Line 1569  contains
1569    
1570      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1571         ztit="after diagcld"         ztit="after diagcld"
1572         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1573              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1574              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1575      END IF      END IF
1576    
# Line 1791  contains Line 1673  contains
1673      DO k = 1, llm      DO k = 1, llm
1674         DO i = 1, klon         DO i = 1, klon
1675            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1676                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1677         ENDDO         ENDDO
1678      ENDDO      ENDDO
1679    
1680      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1681         ztit='after rad'         ztit='after rad'
1682         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1683              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1684              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1685         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1686              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1826  contains Line 1708  contains
1708         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1709      ENDDO      ENDDO
1710    
1711      !moddeblott(jan95)      !mod deb lott(jan95)
1712      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1713      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1714    
1715      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1716         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1717         igwd=0         igwd=0
1718         DO i=1, klon         DO i=1, klon
# Line 1843  contains Line 1724  contains
1724            ENDIF            ENDIF
1725         ENDDO         ENDDO
1726    
1727         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1728              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1729              igwd, idx, itest, &              igwd, idx, itest, &
1730              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1858  contains Line 1739  contains
1739               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
1740            ENDDO            ENDDO
1741         ENDDO         ENDDO
1742        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1743    
1744      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1745    
# Line 1874  contains Line 1754  contains
1754            ENDIF            ENDIF
1755         ENDDO         ENDDO
1756    
1757         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1758              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1759              itest, &              itest, &
1760              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1900  contains Line 1780  contains
1780      ENDDO      ENDDO
1781      DO k = 1, llm      DO k = 1, llm
1782         DO i = 1, klon         DO i = 1, klon
1783            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)
1784                 (paprs(i, k)-paprs(i, k+1))/rg            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)
           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1785         ENDDO         ENDDO
1786      ENDDO      ENDDO
1787    
1788      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1789    
1790      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1791           ra, rg, romega, &           ra, rg, romega, &
1792           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1793           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1919  contains Line 1797  contains
1797    
1798      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1799         ztit='after orography'         ztit='after orography'
1800         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1801              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1802              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1803      END IF      END IF
1804    
1805      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
1806        call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, &
1807      !   Calcul  des tendances traceurs           nqmx-2, pdtphys, u, t, paprs, pplay, pmfu, pmfd, pen_u, pde_u, &
1808             pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1809      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &           frac_impa, frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1810           dtime, u, v, t, paprs, pplay, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1811           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           tr_seri, zmasse)
          ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &  
          pctsrf, frac_impa,  frac_nucl, &  
          presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &  
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1812    
1813      IF (offline) THEN      IF (offline) THEN
1814           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1815         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1816         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)
             t, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             fm_therm, entr_therm, &  
             ycoefh, yu1, yv1, ftsol, pctsrf, &  
             frac_impa, frac_nucl, &  
             pphis, airephy, dtime, itap)  
   
1817      ENDIF      ENDIF
1818    
1819      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1820        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1821             ue, uq)
1822    
1823      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1824    
1825      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1826           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1972  contains Line 1835  contains
1835            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1836                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)
1837            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)
1838            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1839         END DO         END DO
1840      END DO      END DO
1841      !-jld ec_conser      !-jld ec_conser
1842      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1843         ztit='after physic'         ztit='after physic'
1844         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1845              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1846              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1847         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1848         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1997  contains Line 1860  contains
1860    
1861      !   SORTIES      !   SORTIES
1862    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1863      !cc prw = eau precipitable      !cc prw = eau precipitable
1864      DO i = 1, klon      DO i = 1, klon
1865         prw(i) = 0.         prw(i) = 0.
1866         DO k = 1, llm         DO k = 1, llm
1867            prw(i) = prw(i) + &            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)
                q_seri(i, k)*(paprs(i, k)-paprs(i, k+1))/RG  
1868         ENDDO         ENDDO
1869      ENDDO      ENDDO
1870    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1871      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1872    
1873      DO k = 1, llm      DO k = 1, llm
1874         DO i = 1, klon         DO i = 1, klon
1875            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1876            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1877            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1878            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtime            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys
1879            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtime            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys
1880         ENDDO         ENDDO
1881      ENDDO      ENDDO
1882    
1883      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1884         DO iq = 3, nq         DO iq = 3, nqmx
1885            DO  k = 1, llm            DO  k = 1, llm
1886               DO  i = 1, klon               DO  i = 1, klon
1887                  d_qx(i, k, iq) = ( tr_seri(i, k, iq-2) - qx(i, k, iq) ) / dtime                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
1888               ENDDO               ENDDO
1889            ENDDO            ENDDO
1890         ENDDO         ENDDO
1891      ENDIF      ENDIF
1892    
1893      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
   
1894      DO k = 1, llm      DO k = 1, llm
1895         DO i = 1, klon         DO i = 1, klon
1896            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2044  contains Line 1899  contains
1899      ENDDO      ENDDO
1900    
1901      !   Ecriture des sorties      !   Ecriture des sorties
   
1902      call write_histhf      call write_histhf
1903      call write_histday      call write_histday
1904      call write_histins      call write_histins
1905    
1906      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1907      IF (lafin) THEN      IF (lafin) THEN
1908         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1909         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
1910              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
1911              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1912              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
1913              radsol, frugs, agesno, &              radsol, frugs, agesno, &
1914              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1915              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1916      ENDIF      ENDIF
1917    
1918    contains      firstcal = .FALSE.
   
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la  
       ! physique ou toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
   
       ! initialisations diverses au "debut" du mois  
   
       IF(MOD(itap, ecrit_mth) == 1) THEN  
          DO i=1, klon  
             nday_rain(i)=0.  
          ENDDO  
       ENDIF  
   
       IF(MOD(itap, ecrit_day) == 0) THEN  
          !IM calcul total_rain, nday_rain  
          DO i = 1, klon  
             total_rain(i)=rain_fall(i)+snow_fall(i)    
             IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.  
          ENDDO  
       ENDIF  
   
     End SUBROUTINE calcul_divers  
1919    
1920      !***********************************************    contains
1921    
1922      subroutine write_histday      subroutine write_histday
1923    
1924        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use gr_phy_write_3d_m, only: gr_phy_write_3d
1925          integer itau_w  ! pas de temps ecriture
       if (ok_journe) THEN  
   
          ndex2d = 0  
          ndex3d = 0  
1926    
1927           ! Champs 2D:        !------------------------------------------------
1928    
1929          if (ok_journe) THEN
1930           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1931             if (nqmx <= 4) then
1932           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1933                     gr_phy_write_3d(wo) * 1e3)
1934                ! (convert "wo" from kDU to DU)
1935             end if
1936           if (ok_sync) then           if (ok_sync) then
1937              call histsync(nid_day)              call histsync(nid_day)
1938           endif           endif
   
1939        ENDIF        ENDIF
1940    
1941      End subroutine write_histday      End subroutine write_histday
# Line 2449  contains Line 1946  contains
1946    
1947        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09
1948    
1949        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1950    
1951        call write_histhf3d        call write_histhf3d
1952    
# Line 2469  contains Line 1963  contains
1963        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09
1964    
1965        real zout        real zout
1966          integer itau_w  ! pas de temps ecriture
1967    
1968        !--------------------------------------------------        !--------------------------------------------------
1969    
1970        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1971           ! Champs 2D:           ! Champs 2D:
1972    
1973           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
1974           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
1975           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1976    
1977           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1978           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)
1979           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1980    
1981           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1982           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)
1983           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1984    
1985           DO i = 1, klon           DO i = 1, klon
1986              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1987           ENDDO           ENDDO
1988           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1989           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1990    
1991           DO i = 1, klon           DO i = 1, klon
1992              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1993           ENDDO           ENDDO
1994           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1995           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1996    
1997           DO i = 1, klon           DO i = 1, klon
1998              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1999           ENDDO           ENDDO
2000           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2001           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
2002    
2003           DO i = 1, klon           DO i = 1, klon
2004              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2005           ENDDO           ENDDO
2006           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2007           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2008    
2009           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)
2010           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2011           !ccIM           !ccIM
2012           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)
2013           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2014    
2015           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)
2016           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2017    
2018           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)
2019           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2020    
2021           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)
2022           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2023    
2024           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)
2025           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2026    
2027           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)
2028           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2029    
2030           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)
2031           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2032    
2033           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)
2034           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2035    
2036           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)
2037           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2038    
2039           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)
2040           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2041    
2042           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)
2043           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2044    
2045           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)
2046           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2047    
2048           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)
2049           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2050    
2051           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2052           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)
2053           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2054           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2055    
2056           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)
2057           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2058    
2059           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)
2060           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2061    
2062           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)
2063           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2064    
2065           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)
2066           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2067    
2068           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)
2069           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2070    
2071           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2072              !XXX              !XXX
2073              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2074              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2075              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2076                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2077    
2078              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2079              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2080              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2081                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2082    
2083              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2084              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2085              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2086                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2087    
2088              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2089              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2090              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2091                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2092    
2093              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2094              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2095              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2096                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2097    
2098              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2099              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2100              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2101                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2102    
2103              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2104              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2105              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2106                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2107    
2108              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2109              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2110              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2111                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2112    
2113              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2114              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2115              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2116                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2117    
2118           END DO           END DO
2119           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)
2120           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2121           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)
2122           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2123    
2124           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)
2125           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2126    
2127           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2128    
2129           !HBTM2           !HBTM2
2130    
2131           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)
2132           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
2133    
2134           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)
2135           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
2136    
2137           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)
2138           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
2139    
2140           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)
2141           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
2142    
2143           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)
2144           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
2145    
2146           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)
2147           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
2148    
2149           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)
2150           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
2151    
2152           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)
2153           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
2154    
2155           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)
2156           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
2157    
2158           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)
2159           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
               ndex2d)  
2160    
2161           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2162    
2163           ! Champs 3D:           ! Champs 3D:
2164    
2165           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)
2166           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2167    
2168           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2169           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2170    
2171           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2172           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2173    
2174           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)
2175           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2176    
2177           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)
2178           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2179    
2180           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)
2181           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2182    
2183           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)
2184           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2185    
2186           if (ok_sync) then           if (ok_sync) then
2187              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2724  contains Line 2196  contains
2196    
2197        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09
2198    
2199        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2200        ndex3d = 0  
2201          !-------------------------------------------------------
2202    
2203        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2204    
2205        ! Champs 3D:        ! Champs 3D:
2206    
2207        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)
2208        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2209    
2210        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)
2211        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2212    
2213        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2214        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2215    
2216        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2217        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2218    
2219        if (nbtr >= 3) then        if (nbtr >= 3) then
2220           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &
2221                zx_tmp_3d)                zx_tmp_3d)
2222           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, &           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
               ndex3d)  
2223        end if        end if
2224    
2225        if (ok_sync) then        if (ok_sync) then
# Line 2762  contains Line 2230  contains
2230    
2231    END SUBROUTINE physiq    END SUBROUTINE physiq
2232    
   !****************************************************  
   
   FUNCTION qcheck(klon, klev, paprs, q, ql, aire)  
   
     ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28  
   
     use YOMCST  
     IMPLICIT none  
   
     ! Calculer et imprimer l'eau totale. A utiliser pour verifier  
     ! la conservation de l'eau  
   
     INTEGER klon, klev  
     REAL, intent(in):: paprs(klon, klev+1)  
     real q(klon, klev), ql(klon, klev)  
     REAL aire(klon)  
     REAL qtotal, zx, qcheck  
     INTEGER i, k  
   
     zx = 0.0  
     DO i = 1, klon  
        zx = zx + aire(i)  
     ENDDO  
     qtotal = 0.0  
     DO k = 1, klev  
        DO i = 1, klon  
           qtotal = qtotal + (q(i, k)+ql(i, k)) * aire(i) &  
                *(paprs(i, k)-paprs(i, k+1))/RG  
        ENDDO  
     ENDDO  
   
     qcheck = qtotal/zx  
   
   END FUNCTION qcheck  
   
2233  end module physiq_m  end module physiq_m
Legend:
Removed from v.7  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.21