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

Diff of /trunk/Sources/phylmd/physiq.f

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

revision 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC
# Line 1  Line 1 
1  module physiq_m  module physiq_m
2    
   ! This module is clean: no C preprocessor directive, no include line.  
   
3    IMPLICIT none    IMPLICIT none
4    
   private  
   public physiq  
   
5  contains  contains
6    
7    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)
9         d_t, d_qx, d_ps, dudyn, PVteta)  
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)
11      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! Author: Z.X. Li (LMD/CNRS) 1993
12    
13      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! This is the main procedure for the "physics" part of the program.
14    
15      ! Objet: Moniteur general de la physique du modele      use aaam_bud_m, only: aaam_bud
16      !AA      Modifications quant aux traceurs :      USE abort_gcm_m, ONLY: abort_gcm
17      !AA                  -  uniformisation des parametrisations ds phytrac      use aeropt_m, only: aeropt
18      !AA                  -  stockage des moyennes des champs necessaires      use ajsec_m, only: ajsec
19      !AA                     en mode traceur off-line      USE calendar, ONLY: ymds2ju
20        use calltherm_m, only: calltherm
21      USE ioipsl, only: ymds2ju, histwrite, histsync      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
22      use dimens_m, only: jjm, iim, llm           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
23      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
24           clnsurf, epsfra           ok_orodr, ok_orolf, soil_model
25      use dimphy, only: klon, nbtr      USE clmain_m, ONLY: clmain
26      use conf_gcm_m, only: raz_date, offline, iphysiq      USE comgeomphy, ONLY: airephy, cuphy, cvphy
27      use dimsoil, only: nsoilmx      USE concvl_m, ONLY: concvl
28      use temps, only: itau_phy, day_ref, annee_ref, itaufin      USE conf_gcm_m, ONLY: offline, raz_date
29      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      USE conf_phys_m, ONLY: conf_phys
30           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &      use conflx_m, only: conflx
31           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
32           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &      use diagcld2_m, only: diagcld2
33           ok_kzmin, soil_model      use diagetpq_m, only: diagetpq
34      use iniprint, only: lunout, prt_level      use diagphy_m, only: diagphy
35      use abort_gcm_m, only: abort_gcm      USE dimens_m, ONLY: iim, jjm, llm, nqmx
36      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE dimphy, ONLY: klon, nbtr
37      use comgeomphy      USE dimsoil, ONLY: nsoilmx
38      use ctherm      use drag_noro_m, only: drag_noro
39      use phytrac_m, only: phytrac      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
40      use oasis_m      use fisrtilp_m, only: fisrtilp
41      use radepsi      USE hgardfou_m, ONLY: hgardfou
42      use radopt      USE histsync_m, ONLY: histsync
43      use yoethf      USE histwrite_m, ONLY: histwrite
44      use ini_hist, only: ini_histhf, ini_histday, ini_histins      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45      use orbite_m, only: orbite, zenang           nbsrf
46      use phyetat0_m, only: phyetat0, rlat, rlon      USE ini_histhf_m, ONLY: ini_histhf
47      use hgardfou_m, only: hgardfou      USE ini_histday_m, ONLY: ini_histday
48      use conf_phys_m, only: conf_phys      USE ini_histins_m, ONLY: ini_histins
49        use newmicro_m, only: newmicro
50      ! Declaration des constantes et des fonctions thermodynamiques :      USE oasis_m, ONLY: ok_oasis
51      use fcttre, only: thermcep, foeew, qsats, qsatl      USE orbite_m, ONLY: orbite, zenang
52        USE ozonecm_m, ONLY: ozonecm
53      ! Variables argument:      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
54        USE phyredem_m, ONLY: phyredem
55      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      USE phystokenc_m, ONLY: phystokenc
56      REAL rjourvrai ! input numero du jour de l'experience      USE phytrac_m, ONLY: phytrac
57      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      USE qcheck_m, ONLY: qcheck
58      REAL pdtphys ! input pas d'integration pour la physique (seconde)      use radlwsw_m, only: radlwsw
59      LOGICAL, intent(in):: debut ! premier passage      use sugwd_m, only: sugwd
60        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61        USE temps, ONLY: annee_ref, day_ref, itau_phy
62        use unit_nml_m, only: unit_nml
63        USE yoethf_m, ONLY: r2es, rvtmp2
64    
65        ! Arguments:
66    
67        REAL, intent(in):: rdayvrai
68        ! (elapsed time since January 1st 0h of the starting year, in days)
69    
70        REAL, intent(in):: time ! heure de la journée en fraction de jour
71        REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
72      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
73    
74      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
75      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
76        
77      REAL pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
78      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
79    
80      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
81      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
82    
83      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
84    
85        REAL, intent(in):: u(klon, llm)
86        ! vitesse dans la direction X (de O a E) en m/s
87    
88        REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
89        REAL, intent(in):: t(klon, llm) ! input temperature (K)
90    
91        REAL, intent(in):: qx(klon, llm, nqmx)
92        ! (humidité spécifique et fractions massiques des autres traceurs)
93    
94      REAL presnivs(llm)      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
95      ! (input pressions approximat. des milieux couches ( en PA))      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
96        REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
97        REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
98        REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
99        REAL d_ps(klon) ! output tendance physique de la pression au sol
100    
101      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      LOGICAL:: firstcal = .true.
     REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s  
     REAL t(klon, llm)  ! input temperature (K)  
   
     REAL qx(klon, llm, nq)  
     ! (input humidite specifique (kg/kg) et d'autres traceurs)  
   
     REAL omega(klon, llm)  ! input vitesse verticale en Pa/s  
     REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)  
     REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
     REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)  
     REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon)  ! output tendance physique de la pression au sol  
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
105    
106      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
107      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
108    
     LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
109      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
110      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
111    
112      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
113      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
114      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
115      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
116        ! Ajouter artificiellement les stratus
117    
118      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
119      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
120      logical rnpb      logical rnpb
121      parameter(rnpb=.true.)      parameter(rnpb = .true.)
122      !      ocean = type de modele ocean a utiliser: force, slab, couple  
123      character(len=6) ocean      character(len = 6):: ocean = 'force '
124      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
125    
126      logical ok_ocean      logical ok_ocean
127      SAVE ok_ocean      SAVE ok_ocean
128    
129      !IM "slab" ocean      ! "slab" ocean
130      REAL tslab(klon)    !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
131      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
132      REAL seaice(klon)   !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
133      SAVE seaice      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxo(klon)    !flux turbulents ocean-glace de mer  
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
134    
135      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
136      logical ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     save ok_veget  
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
137    
138      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
139      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
140        ! fichiers histday, histmth et histins
141    
142      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
143      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
144    
145      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
146      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
147      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
148      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
     save q2  
149    
150      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
151      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
152      INTEGER iliq          ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
153      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
154    
155      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
156      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
157    
158      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
159      REAL d_q_dyn(klon, llm)  ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)
160    
161      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
162    
163      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
164    
165      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
166      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
167      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
168      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 172  contains Line 170  contains
170      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
171    
172      INTEGER klevp1      INTEGER klevp1
173      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
174    
175      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
176      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
177      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
178    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
179      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
180      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
181      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
182    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
183      !IM Amip2      !IM Amip2
184      ! variables a une pression donnee      ! variables a une pression donnee
185    
186      integer nlevSTD      integer nlevSTD
187      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
188      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
189      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
190           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
191           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
192      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
193      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
194           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
195           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
   
     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  
196    
197      ! prw: precipitable water      ! prw: precipitable water
198      real prw(klon)      real prw(klon)
# Line 263  contains Line 202  contains
202      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
203      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
204    
205      INTEGER l, kmax, lmax      INTEGER kmax, lmax
206      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
207      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
208      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
209    
210      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
211      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
# Line 277  contains Line 216  contains
216      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
217    
218      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
219      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
220    
221      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
222      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
223      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
224    
225      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
226      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
227           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
228           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 315  contains Line 254  contains
254      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
255      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
256    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
   
257      ! Variables propres a la physique      ! Variables propres a la physique
258    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
259      INTEGER, save:: radpas      INTEGER, save:: radpas
260      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
261      ! "physiq".)      ! "physiq".)
262    
263      REAL radsol(klon)      REAL radsol(klon)
264      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
265    
266      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
267    
268      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
269    
270      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
271      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
272    
273      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
274      SAVE fevap                 ! evaporation      SAVE fevap ! evaporation
275      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
276      SAVE fluxlat      SAVE fluxlat
277    
278      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
279      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
280    
281      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
282    
283      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
284      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
285    
286      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
287      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
288      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
289      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
290    
291      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
292        REAL, save:: zmea(klon) ! orographie moyenne
293      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
294      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
295        REAL, save:: zgam(klon) ! anisotropie de l'OESM
296      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
297      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
298        REAL, save:: zval(klon) ! Minimum de l'OESM
299      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  
300    
301      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
302    
303      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
304    
305      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
306      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
307    
308      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
309      SAVE run_off_lic_0      SAVE run_off_lic_0
310      !KE43      !KE43
311      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
312    
313      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
314      SAVE bas      SAVE bas
315      SAVE top      SAVE top
316    
317      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
318      SAVE Ma      SAVE Ma
319      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
320      SAVE qcondc      SAVE qcondc
321      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
322      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
323    
324      REAL wd(klon) ! sb      REAL wd(klon) ! sb
325      SAVE wd       ! sb      SAVE wd ! sb
326    
327      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
328    
# Line 423  contains Line 331  contains
331      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
332      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
333    
334      !AA  Pour phytrac      !AA Pour phytrac
335      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
336      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
337      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
338      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
339      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
340      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
341      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
342      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
343    
344      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 442  contains Line 350  contains
350      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
351      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
352    
353      !AA      REAL, save:: rain_fall(klon) ! pluie
354      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
     REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
     REAL rain_tiedtke(klon), snow_tiedtke(klon)  
355    
356      REAL total_rain(klon), nday_rain(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
     save nday_rain  
357    
358      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
359      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
360      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
361      SAVE dlw      SAVE dlw
362      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
363      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 472  contains Line 375  contains
375    
376      INTEGER julien      INTEGER julien
377    
378      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
379      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
380      !IM      !IM
381      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
382    
383      SAVE pctsrf                 ! sous-fraction du sol      SAVE pctsrf ! sous-fraction du sol
384      REAL albsol(klon)      REAL albsol(klon)
385      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
386      REAL albsollw(klon)      REAL albsollw(klon)
387      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
388    
389      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
390    
391      ! Declaration des procedures appelees      ! Declaration des procedures appelees
392    
393      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec     ! ajustement sec  
     EXTERNAL clmain    ! couche limite  
394      !KE43      !KE43
395      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
396      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL nuage ! calculer les proprietes radiatives
397      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL ozonecm   ! prescrire l'ozone  
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
   
     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  
398    
399      ! Variables locales      ! Variables locales
400    
# Line 509  contains Line 403  contains
403    
404      save rnebcon, clwcon      save rnebcon, clwcon
405    
406      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
407      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
408      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
409      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
410      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
411      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
412      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
413    
414      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
415      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
416      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
417      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
418    
419      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
420      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
421      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
422      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
423    
424      REAL heat(klon, llm)    ! chauffage solaire      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que
425      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! les variables soient rémanentes.
426      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
427      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
428      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
429      real sollwdown(klon)    ! downward LW flux at surface      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
430      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)
431        real sollwdown(klon) ! downward LW flux at surface
432        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
433      REAL albpla(klon)      REAL albpla(klon)
434      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
435      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
436      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla, sollwdown
437      !                      sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
438    
439      INTEGER itaprad      INTEGER itaprad
440      SAVE itaprad      SAVE itaprad
441    
442      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
443      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
444    
445      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
446      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 561  contains Line 455  contains
455      LOGICAL zx_ajustq      LOGICAL zx_ajustq
456    
457      REAL za, zb      REAL za, zb
458      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
459      real zqsat(klon, llm)      real zqsat(klon, llm)
460      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
461      REAL t_coup      REAL t_coup
462      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
463    
464      REAL zphi(klon, llm)      REAL zphi(klon, llm)
465    
466      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
467    
468      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
469      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
470      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
471      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
472      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
473      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
474      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
475      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
476      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
477      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
478      ! Grdeurs de sorties      ! Grdeurs de sorties
479      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
480      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
481      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
482      REAL s_trmb3(klon)      REAL s_trmb3(klon)
483    
484      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
485    
486      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
487      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
488      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
489      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
490      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
491      SAVE cape      SAVE cape
492    
493      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
494      SAVE pbase      SAVE pbase
495      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
496      SAVE bbase      SAVE bbase
497      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
498      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
499      ! -- convect43:      ! -- convect43:
500      INTEGER ntra              ! nb traceurs pour convect4.3      INTEGER ntra ! nb traceurs pour convect4.3
501      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
502      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
503    
504      ! Variables du changement      ! Variables du changement
505    
506      ! con: convection      ! con: convection
507      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
508      ! ajs: ajustement sec      ! ajs: ajustement sec
509      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
510      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
511      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
512      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
513      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
# Line 625  contains Line 519  contains
519      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
520      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
521      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
522      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
523      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
524    
525      INTEGER ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
   
     SAVE ibas_con, itop_con  
526    
527      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
528      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 644  contains Line 536  contains
536      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
537      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
538    
539      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
540      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
541      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
542    
543      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
544      real fact_cldcon      real:: fact_cldcon = 0.375
545      real facttemps      real:: facttemps = 1.e-4
546      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
     save fact_cldcon, facttemps  
547      real facteur      real facteur
548    
549      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
550      logical ptconv(klon, llm)      logical ptconv(klon, llm)
551    
552      ! Variables liees a l'ecriture de la bande histoire physique      ! Variables locales pour effectuer les appels en série :
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
     ! Variables locales pour effectuer les appels en serie  
553    
554      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
555      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 676  contains Line 560  contains
560    
561      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
562    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
563      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
564      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
565      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
566      REAL aam, torsfc      REAL aam, torsfc
567    
568      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
   
     REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique  
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
569    
570        REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
571      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)
572    
573      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
574    
575      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.
576      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 704  contains Line 579  contains
579    
580      REAL zsto      REAL zsto
581    
582      character(len=20) modname      character(len = 20) modname
583      character(len=80) abort_message      character(len = 80) abort_message
584      logical ok_sync      logical ok_sync
585      real date0      real date0
586    
587      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
588      REAL ztsol(klon)      REAL ztsol(klon)
589      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
590      REAL      d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
591      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
592      SAVE      d_h_vcol_phy      REAL zero_v(klon)
593      REAL      zero_v(klon)      CHARACTER(LEN = 15) tit
594      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
595      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
596      SAVE      ip_ebil  
597      DATA      ip_ebil/0/      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
     INTEGER   if_ebil ! level for energy conserv. dignostics  
     SAVE      if_ebil  
     !+jld ec_conser  
     REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique  
598      REAL ZRCPD      REAL ZRCPD
599      !-jld ec_conser  
600      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m  
601      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
602      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
603      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
604      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
605      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
606    
607      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
608      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
609    
610      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
611      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
612    
613      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
614      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
615    
616      ! Aerosol optical properties      ! Aerosol optical properties
617      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
618      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
619    
620      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
621      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade --> ADE = topswad - topsw
622    
623      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
624      ! ok_aie=T ->      ! ok_aie .and. ok_ade --> AIE = topswai - topswad
625      !        ok_ade=T -AIE=topswai-topswad      ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw
     !        ok_ade=F -AIE=topswai-topsw  
626    
627      REAL aerindex(klon)       ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
628    
629      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
630      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
631      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)  
632        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
633        ! Parameters in the formula to link CDNC to aerosol mass conc
634        ! (Boucher and Lohmann, 1995), used in nuage.F
635    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
636      SAVE u10m      SAVE u10m
637      SAVE v10m      SAVE v10m
638      SAVE t2m      SAVE t2m
639      SAVE q2m      SAVE q2m
640      SAVE ffonte      SAVE ffonte
641      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
642      SAVE rain_con      SAVE rain_con
643      SAVE snow_con      SAVE snow_con
644      SAVE topswai      SAVE topswai
# Line 782  contains Line 649  contains
649      SAVE d_v_con      SAVE d_v_con
650      SAVE rnebcon0      SAVE rnebcon0
651      SAVE clwcon0      SAVE clwcon0
652      SAVE pblh  
653      SAVE plcl      real zmasse(klon, llm)
654      SAVE capCL      ! (column-density of mass of air in a cell, in kg m-2)
655      SAVE oliqCL  
656      SAVE cteiCL      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
657      SAVE pblt  
658      SAVE therm      namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
659      SAVE trmb1           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
660      SAVE trmb2           ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
661      SAVE trmb3           nsplit_thermals
662    
663      !----------------------------------------------------------------      !----------------------------------------------------------------
664    
665      modname = 'physiq'      modname = 'physiq'
666      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
667         DO i=1, klon         DO i = 1, klon
668            zero_v(i)=0.            zero_v(i) = 0.
669         END DO         END DO
670      END IF      END IF
671      ok_sync=.TRUE.      ok_sync = .TRUE.
672      IF (nq .LT. 2) THEN      IF (nqmx < 2) THEN
673         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
674         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
675      ENDIF      ENDIF
676    
677      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
678           ! initialiser
679           u10m = 0.
680           v10m = 0.
681           t2m = 0.
682           q2m = 0.
683           ffonte = 0.
684           fqcalving = 0.
685           piz_ae = 0.
686           tau_ae = 0.
687           cg_ae = 0.
688           rain_con(:) = 0.
689           snow_con(:) = 0.
690           bl95_b0 = 0.
691           bl95_b1 = 0.
692           topswai(:) = 0.
693           topswad(:) = 0.
694           solswai(:) = 0.
695           solswad(:) = 0.
696    
697           d_u_con = 0.0
698           d_v_con = 0.0
699           rnebcon0 = 0.0
700           clwcon0 = 0.0
701           rnebcon = 0.0
702           clwcon = 0.0
703    
704           pblh =0. ! Hauteur de couche limite
705           plcl =0. ! Niveau de condensation de la CLA
706           capCL =0. ! CAPE de couche limite
707           oliqCL =0. ! eau_liqu integree de couche limite
708           cteiCL =0. ! cloud top instab. crit. couche limite
709           pblt =0. ! T a la Hauteur de couche limite
710           therm =0.
711           trmb1 =0. ! deep_cape
712           trmb2 =0. ! inhibition
713           trmb3 =0. ! Point Omega
714    
715           IF (if_ebil >= 1) d_h_vcol_phy = 0.
716    
717           iflag_thermals = 0
718           nsplit_thermals = 1
719           print *, "Enter namelist 'physiq_nml'."
720           read(unit=*, nml=physiq_nml)
721           write(unit_nml, nml=physiq_nml)
722    
723      test_debut: IF (debut) THEN         ! Appel à la lecture du run.def physique
724         !  initialiser         call conf_phys
        u10m(:, :)=0.  
        v10m(:, :)=0.  
        t2m(:, :)=0.  
        q2m(:, :)=0.  
        ffonte(:, :)=0.  
        fqcalving(:, :)=0.  
        piz_ae(:, :, :)=0.  
        tau_ae(:, :, :)=0.  
        cg_ae(:, :, :)=0.  
        rain_con(:)=0.  
        snow_con(:)=0.  
        bl95_b0=0.  
        bl95_b1=0.  
        topswai(:)=0.  
        topswad(:)=0.  
        solswai(:)=0.  
        solswad(:)=0.  
   
        d_u_con(:, :) = 0.0  
        d_v_con(:, :) = 0.0  
        rnebcon0(:, :) = 0.0  
        clwcon0(:, :) = 0.0  
        rnebcon(:, :) = 0.0  
        clwcon(:, :) = 0.0  
   
        pblh(:, :)   =0.        ! Hauteur de couche limite  
        plcl(:, :)   =0.        ! Niveau de condensation de la CLA  
        capCL(:, :)  =0.        ! CAPE de couche limite  
        oliqCL(:, :) =0.        ! eau_liqu integree de couche limite  
        cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite  
        pblt(:, :)   =0.        ! T a la Hauteur de couche limite  
        therm(:, :)  =0.  
        trmb1(:, :)  =0.        ! deep_cape  
        trmb2(:, :)  =0.        ! inhibition  
        trmb3(:, :)  =0.        ! Point Omega  
   
        IF (if_ebil >= 1) d_h_vcol_phy=0.  
   
        ! appel a la lecture du run.def physique  
   
        call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &  
             ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
725    
726         ! Initialiser les compteurs:         ! Initialiser les compteurs:
727    
728         frugs = 0.         frugs = 0.
729         itap = 0         itap = 0
730         itaprad = 0         itaprad = 0
731         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
732              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
733              ocean, tslab, seaice, & !IM "slab" ocean              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
734              fqsurf, qsol, fsnow, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
735              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             dlw, radsol, frugs, agesno, clesphy0, &  
             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &  
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
736    
737         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
738         q2(:, :, :)=1.e-8         q2 = 1.e-8
739    
740         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
741    
742         ! on remet le calendrier a zero         ! on remet le calendrier a zero
743           IF (raz_date) itau_phy = 0
744    
745         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
746    
747         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
748            ok_ocean=.TRUE.            ok_ocean = .TRUE.
749         ENDIF         ENDIF
750    
751         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
752              ok_instan, ok_region )              ok_region)
753    
754         IF (ABS(dtime-pdtphys).GT.0.001) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
755            WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &            print *, 'Nbre d appels au rayonnement insuffisant'
756                 pdtphys            print *, "Au minimum 4 appels par jour si cycle diurne"
757            abort_message='Pas physique n est pas correct '            abort_message = 'Nbre d appels au rayonnement insuffisant'
758            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
759         ENDIF         ENDIF
760           print *, "Clef pour la convection, iflag_con = ", iflag_con
        IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN  
           WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'  
           WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con  
        WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
761    
762         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
763         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
764              print *, "Convection de Kerry Emanuel 4.3"
765    
           WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "  
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
766            DO i = 1, klon            DO i = 1, klon
767               ibas_con(i) = 1               ibas_con(i) = 1
768               itop_con(i) = 1               itop_con(i) = 1
769            ENDDO            ENDDO
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
770         ENDIF         ENDIF
771    
772         IF (ok_orodr) THEN         IF (ok_orodr) THEN
773            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
774               rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)            CALL SUGWD(paprs, play)
775            ENDDO         else
776            CALL SUGWD(klon, llm, paprs, pplay)            rugoro = 0.
777         ENDIF         ENDIF
778    
779         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
780         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
781    
782         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/dtphys)
783         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/dtphys)
784         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/dtphys)
785         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
786         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/dtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
787    
788         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
789    
790         npas = 0         npas = 0
791         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  
   
        write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con  
792    
793         !   Initialisation des sorties         ! Initialisation des sorties
794    
795         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
796         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
797         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
798         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
799         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
800         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
801      ENDIF test_debut      ENDIF test_firstcal
802    
803      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
804    
805      DO i = 1, klon      DO i = 1, klon
806         d_ps(i) = 0.0         d_ps(i) = 0.0
807      ENDDO      ENDDO
808      DO k = 1, llm      DO iq = 1, nqmx
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
     DO iq = 1, nq  
809         DO k = 1, llm         DO k = 1, llm
810            DO i = 1, klon            DO i = 1, klon
811               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
812            ENDDO            ENDDO
813         ENDDO         ENDDO
814      ENDDO      ENDDO
815      da(:, :)=0.      da = 0.
816      mp(:, :)=0.      mp = 0.
817      phi(:, :, :)=0.      phi = 0.
818    
819      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrées de u, v, h, et q :
820    
821      DO k = 1, llm      DO k = 1, llm
822         DO i = 1, klon         DO i = 1, klon
823            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
824            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
825            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
826            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
827            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
828            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
829         ENDDO         ENDDO
830      ENDDO      ENDDO
831      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
832         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
833      ELSE      ELSE
834         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
835      ENDIF      ENDIF
# Line 1017  contains Line 844  contains
844      ENDDO      ENDDO
845    
846      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
847         ztit='after dynamic'         tit = 'after dynamics'
848         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
849              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
850              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
851         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
852         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
853         !     est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
854         !     Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
855         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
856              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
857              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
858              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
859      END IF      END IF
860    
861      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
862      IF (ancien_ok) THEN      IF (ancien_ok) THEN
863         DO k = 1, llm         DO k = 1, llm
864            DO i = 1, klon            DO i = 1, klon
865               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)) / dtphys
866               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)) / dtphys
867            ENDDO            ENDDO
868         ENDDO         ENDDO
869      ELSE      ELSE
# Line 1052  contains Line 877  contains
877      ENDIF      ENDIF
878    
879      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
880      DO k = 1, llm      DO k = 1, llm
881         DO i = 1, klon         DO i = 1, klon
882            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
883         ENDDO         ENDDO
884      ENDDO      ENDDO
885    
886      ! Verifier les temperatures      ! Check temperatures:
   
887      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
888    
889      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
890        itap = itap + 1
891      itap   = itap + 1      julien = MOD(NINT(rdayvrai), 360)
     julien = MOD(NINT(xjour), 360)  
892      if (julien == 0) julien = 360      if (julien == 0) julien = 360
893    
894      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
895    
896      IF (MOD(itap - 1, lmt_pas) == 0) THEN      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
        CALL ozonecm(REAL(julien), rlat, paprs, wo)  
     ENDIF  
897    
898      ! Re-evaporer l'eau liquide nuageuse      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
899        wo = ozonecm(REAL(julien), paprs)
900    
901      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
902        DO k = 1, llm
903         DO i = 1, klon         DO i = 1, klon
904            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
905            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
906            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
907            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
908         ENDDO         ENDDO
909      ENDDO      ENDDO
910        ql_seri = 0.
911    
912      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
913         ztit='after reevap'         tit = 'after reevap'
914         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
915              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
916              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
917         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
918              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
919              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
920    
921      END IF      END IF
922    
# Line 1125  contains Line 940  contains
940    
941      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
942      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
943         zdtime = dtime * REAL(radpas)         zdtime = dtphys * REAL(radpas)
944         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
945      ELSE      ELSE
946         rmu0 = -999.999         rmu0 = -999.999
947      ENDIF      ENDIF
948    
949      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
950      albsol(:)=0.      albsol(:) = 0.
951      albsollw(:)=0.      albsollw(:) = 0.
952      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
953         DO i = 1, klon         DO i = 1, klon
954            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1141  contains Line 956  contains
956         ENDDO         ENDDO
957      ENDDO      ENDDO
958    
959      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
960      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
961    
962      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1154  contains Line 969  contains
969    
970      fder = dlw      fder = dlw
971    
972      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
973           t_seri, q_seri, u_seri, v_seri, &  
974           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
975           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
976           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
977           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
978           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
979           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
980           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
981           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
982           debut, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
983           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
984           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
985           q2, dsens, devap, &      ! Incrémentation des flux
986           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
987           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
988           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
989           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
990           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
991      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
992         DO k = 1, llm         DO k = 1, llm
993            DO i = 1, klon            DO i = 1, klon
994               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
995                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
996               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
997                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
998               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
999                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1000               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1001                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1002            END DO            END DO
1003         END DO         END DO
1004      END DO      END DO
# Line 1210  contains Line 1018  contains
1018      ENDDO      ENDDO
1019    
1020      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1021         ztit='after clmain'         tit = 'after clmain'
1022         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1023              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1024              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1025         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1026              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1027              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1028      END IF      END IF
1029    
1030      ! Incrementer la temperature du sol      ! Update surface temperature:
1031    
1032      DO i = 1, klon      DO i = 1, klon
1033         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1245  contains Line 1051  contains
1051         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1052         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1053    
1054         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1055              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1056              THEN              THEN
1057            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1058                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1059         ENDIF         ENDIF
1060      ENDDO      ENDDO
# Line 1263  contains Line 1069  contains
1069            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1070            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1071            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1072            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1073                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1074            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1075            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)
# Line 1282  contains Line 1088  contains
1088    
1089      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1090         DO i = 1, klon         DO i = 1, klon
1091            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1092    
1093            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1094            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1095            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1096            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1097            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1098            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1099                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1100            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1101            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1102            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1103            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1104            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1105            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1106            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1107            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1108            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1109            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1110         ENDDO         ENDDO
1111      ENDDO      ENDDO
1112    
# Line 1314  contains Line 1120  contains
1120    
1121      DO k = 1, llm      DO k = 1, llm
1122         DO i = 1, klon         DO i = 1, klon
1123            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1124                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/dtphys
1125            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1126                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/dtphys
1127         ENDDO         ENDDO
1128      ENDDO      ENDDO
1129      IF (check) THEN      IF (check) THEN
1130         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1131         WRITE(lunout, *) "avantcon=", za         print *, "avantcon = ", za
1132      ENDIF      ENDIF
1133      zx_ajustq = .FALSE.      zx_ajustq = iflag_con == 2
     IF (iflag_con == 2) zx_ajustq=.TRUE.  
1134      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1135         DO i = 1, klon         DO i = 1, klon
1136            z_avant(i) = 0.0            z_avant(i) = 0.0
1137         ENDDO         ENDDO
1138         DO k = 1, llm         DO k = 1, llm
1139            DO i = 1, klon            DO i = 1, klon
1140               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)) &
1141                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1142            ENDDO            ENDDO
1143         ENDDO         ENDDO
1144      ENDIF      ENDIF
1145      IF (iflag_con == 1) THEN  
1146         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1147      ELSE IF (iflag_con == 2) THEN      case (2)
1148         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1149              conv_t, conv_q, zxfluxq(1, 1), omega, &              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1150              d_t_con, d_q_con, rain_con, snow_con, &              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1151              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmflxs)
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
1152         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1153         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1154         DO i = 1, klon         DO i = 1, klon
1155            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1156            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1157         ENDDO         ENDDO
1158      ELSE IF (iflag_con >= 3) THEN      case (3:)
1159         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1160         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1161         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1162         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1163         ntra = 1         ntra = 1
1164         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1165         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1166    
1167         IF (ok_cvl) THEN ! new driver for convectL         CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &
1168                v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1169            CALL concvl (iflag_con, &              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &
1170                 dtime, paprs, pplay, t_seri, q_seri, &              upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &
1171                 u_seri, v_seri, tr_seri, ntra, &              dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
1172                 ema_work1, ema_work2, &              da, phi, mp)
1173                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &         clwcon0 = qcondc
1174                 rain_con, snow_con, ibas_con, itop_con, &         pmfu = upwd + dnwd
                upwd, dnwd, dnwd0, &  
                Ma, cape, tvp, iflagctrl, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
   
           clwcon0=qcondc  
           pmfu(:, :)=upwd(:, :)+dnwd(:, :)  
   
        ELSE ! ok_cvl  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (dtime, &  
                paprs, pplay, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
   
        ENDIF ! ok_cvl  
1175    
1176         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1177            do i = 1, klon            do i = 1, klon
1178               wd(i)=0.0               wd(i) = 0.0
1179            enddo            enddo
1180         ENDIF         ENDIF
1181    
1182         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1183    
1184         DO k = 1, llm         DO k = 1, llm
1185            DO i = 1, klon            DO i = 1, klon
1186               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1187               IF (thermcep) THEN               IF (thermcep) THEN
1188                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1189                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1190                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1191                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1192                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1193               ELSE               ELSE
1194                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1195                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1196                  ELSE                  ELSE
1197                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1198                  ENDIF                  ENDIF
1199               ENDIF               ENDIF
1200               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1201            ENDDO            ENDDO
1202         ENDDO         ENDDO
1203    
1204         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1205         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0 = fact_cldcon*clwcon0
1206         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1207              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1208      ELSE      case default
1209         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1210         stop 1         stop 1
1211      ENDIF      END select
1212    
1213      DO k = 1, llm      DO k = 1, llm
1214         DO i = 1, klon         DO i = 1, klon
# Line 1440  contains Line 1220  contains
1220      ENDDO      ENDDO
1221    
1222      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1223         ztit='after convect'         tit = 'after convect'
1224         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1225              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1226              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1227         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1228              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1229              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1230      END IF      END IF
1231    
1232      IF (check) THEN      IF (check) THEN
1233         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1234         WRITE(lunout, *)"aprescon=", za         print *, "aprescon = ", za
1235         zx_t = 0.0         zx_t = 0.0
1236         za = 0.0         za = 0.0
1237         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1239  contains
1239            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1240                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1241         ENDDO         ENDDO
1242         zx_t = zx_t/za*dtime         zx_t = zx_t/za*dtphys
1243         WRITE(lunout, *)"Precip=", zx_t         print *, "Precip = ", zx_t
1244      ENDIF      ENDIF
1245      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1246         DO i = 1, klon         DO i = 1, klon
# Line 1470  contains Line 1248  contains
1248         ENDDO         ENDDO
1249         DO k = 1, llm         DO k = 1, llm
1250            DO i = 1, klon            DO i = 1, klon
1251               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)) &
1252                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1253            ENDDO            ENDDO
1254         ENDDO         ENDDO
1255         DO i = 1, klon         DO i = 1, klon
1256            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))*dtphys) &
1257                 /z_apres(i)                 /z_apres(i)
1258         ENDDO         ENDDO
1259         DO k = 1, llm         DO k = 1, llm
1260            DO i = 1, klon            DO i = 1, klon
1261               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i).LT.(1.0-1.0E-08)) THEN  
1262                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1263               ENDIF               ENDIF
1264            ENDDO            ENDDO
1265         ENDDO         ENDDO
1266      ENDIF      ENDIF
1267      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1268    
1269      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1270    
1271      d_t_ajs(:, :)=0.      d_t_ajs = 0.
1272      d_u_ajs(:, :)=0.      d_u_ajs = 0.
1273      d_v_ajs(:, :)=0.      d_v_ajs = 0.
1274      d_q_ajs(:, :)=0.      d_q_ajs = 0.
1275      fm_therm(:, :)=0.      fm_therm = 0.
1276      entr_therm(:, :)=0.      entr_therm = 0.
1277    
1278      IF(prt_level>9)WRITE(lunout, *) &      if (iflag_thermals == 0) then
1279           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1280           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
1281      if(iflag_thermals.lt.0) then         t_seri = t_seri + d_t_ajs
1282         !  Rien         q_seri = q_seri + d_q_ajs
        IF(prt_level>9)WRITE(lunout, *)'pas de convection'  
     else if(iflag_thermals == 0) then  
        !  Ajustement sec  
        IF(prt_level>9)WRITE(lunout, *)'ajsec'  
        CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)  
        t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)  
        q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)  
1283      else      else
1284         !  Thermiques         ! Thermiques
1285         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1286              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
        call calltherm(pdtphys &  
             , pplay, paprs, pphi &  
             , u_seri, v_seri, t_seri, q_seri &  
             , d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs &  
             , fm_therm, entr_therm)  
1287      endif      endif
1288    
1289      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1290         ztit='after dry_adjust'         tit = 'after dry_adjust'
1291         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1292              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1293              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1294      END IF      END IF
1295    
1296      !  Caclul des ratqs      ! Caclul des ratqs
1297    
1298      !   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q
1299      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1300      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1301         do k=1, llm         do k = 1, llm
1302            do i=1, klon            do i = 1, klon
1303               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1304                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1305                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1306               else               else
1307                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1308               endif               endif
1309            enddo            enddo
1310         enddo         enddo
1311      endif      endif
1312    
1313      !   ratqs stables      ! ratqs stables
1314      do k=1, llm      do k = 1, llm
1315         do i=1, klon         do i = 1, klon
1316            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1317                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1318         enddo         enddo
1319      enddo      enddo
1320    
1321      !  ratqs final      ! ratqs final
1322      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1323         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1324         !   ratqs final         ! ratqs final
1325         !   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
1326         !   relaxation des ratqs         ! relaxation des ratqs
1327         facteur=exp(-pdtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1328         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs = max(ratqs*facteur, ratqss)
1329         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs = max(ratqs, ratqsc)
1330      else      else
1331         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1332         ratqs(:, :)=ratqss(:, :)         ratqs = ratqss
1333      endif      endif
1334    
1335      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1336      ! et le processus de precipitation      ! précipitation :
1337      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1338           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1339           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1340           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1341    
1342      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1343      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1590  contains Line 1352  contains
1352      ENDDO      ENDDO
1353      IF (check) THEN      IF (check) THEN
1354         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1355         WRITE(lunout, *)"apresilp=", za         print *, "apresilp = ", za
1356         zx_t = 0.0         zx_t = 0.0
1357         za = 0.0         za = 0.0
1358         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1360  contains
1360            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1361                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1362         ENDDO         ENDDO
1363         zx_t = zx_t/za*dtime         zx_t = zx_t/za*dtphys
1364         WRITE(lunout, *)"Precip=", zx_t         print *, "Precip = ", zx_t
1365      ENDIF      ENDIF
1366    
1367      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1368         ztit='after fisrt'         tit = 'after fisrt'
1369         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1370              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1371              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1372         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1373              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1374              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1375      END IF      END IF
1376    
1377      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1378    
1379      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1380    
1381      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1382         snow_tiedtke=0.         ! seulement pour Tiedtke
1383           snow_tiedtke = 0.
1384         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1385            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1386         else         else
1387            rain_tiedtke=0.            rain_tiedtke = 0.
1388            do k=1, llm            do k = 1, llm
1389               do i=1, klon               do i = 1, klon
1390                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1391                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1392                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1393                  endif                  endif
1394               enddo               enddo
1395            enddo            enddo
1396         endif         endif
1397    
1398         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1399         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1400              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1401              diafra, dialiq)              diafra, dialiq)
1402         DO k = 1, llm         DO k = 1, llm
1403            DO i = 1, klon            DO i = 1, klon
1404               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1405                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1406                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1407               ENDIF               ENDIF
1408            ENDDO            ENDDO
1409         ENDDO         ENDDO
   
1410      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1411         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1412         !  convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1413         !  facttemps         ! facttemps
1414         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1415         do k=1, llm         do k = 1, llm
1416            do i=1, klon            do i = 1, klon
1417               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1418               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1419                    then                    then
1420                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1421                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1422               endif               endif
1423            enddo            enddo
1424         enddo         enddo
1425    
1426         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1427         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1428         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq = cldliq + rnebcon*clwcon
   
1429      ENDIF      ENDIF
1430    
1431      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1432    
1433      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1434         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1435         DO k = 1, llm         DO k = 1, llm
1436            DO i = 1, klon            DO i = 1, klon
1437               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1438                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1439                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1440               ENDIF               ENDIF
# Line 1684  contains Line 1443  contains
1443      ENDIF      ENDIF
1444    
1445      ! Precipitation totale      ! Precipitation totale
   
1446      DO i = 1, klon      DO i = 1, klon
1447         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1448         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1449      ENDDO      ENDDO
1450    
1451      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1452         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1453         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
1454    
1455        ! Humidité relative pour diagnostic :
1456      DO k = 1, llm      DO k = 1, llm
1457         DO i = 1, klon         DO i = 1, klon
1458            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1459            IF (thermcep) THEN            IF (thermcep) THEN
1460               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1461               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1462               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1463               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1464               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1465            ELSE            ELSE
1466               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1467                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1468               ELSE               ELSE
1469                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1470               ENDIF               ENDIF
1471            ENDIF            ENDIF
1472            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1473            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1474         ENDDO         ENDDO
1475      ENDDO      ENDDO
1476      !jq - introduce the aerosol direct and first indirect radiative forcings  
1477      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1478      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1479         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1480         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1481         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1482    
1483         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1484         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1485      ELSE      ELSE
1486         tau_ae(:, :, :)=0.0         tau_ae = 0.
1487         piz_ae(:, :, :)=0.0         piz_ae = 0.
1488         cg_ae(:, :, :)=0.0         cg_ae = 0.
1489      ENDIF      ENDIF
1490    
1491      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! parametres pour diagnostiques:  
   
1492      if (ok_newmicro) then      if (ok_newmicro) then
1493         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1494              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1495              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1496              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1497      else      else
1498         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1499              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1500              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1501      endif      endif
1502    
1503      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1504      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1505         DO i = 1, klon         DO i = 1, klon
1506            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1771  contains Line 1512  contains
1512                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1513                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1514         ENDDO         ENDDO
1515         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1516         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1517              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1518              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1519              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1520              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1521              topsw, toplw, solsw, sollw, &              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
             sollwdown, &  
             topsw0, toplw0, solsw0, sollw0, &  
             lwdn0, lwdn, lwup0, lwup,  &  
             swdn0, swdn, swup0, swup, &  
             ok_ade, ok_aie, & ! new for aerosol radiative effects  
             tau_ae, piz_ae, cg_ae, &  
             topswad, solswad, &  
             cldtaupi, &  
             topswai, solswai)  
1522         itaprad = 0         itaprad = 0
1523      ENDIF      ENDIF
1524      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1795  contains Line 1527  contains
1527    
1528      DO k = 1, llm      DO k = 1, llm
1529         DO i = 1, klon         DO i = 1, klon
1530            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * dtime/86400.  
1531         ENDDO         ENDDO
1532      ENDDO      ENDDO
1533    
1534      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1535         ztit='after rad'         tit = 'after rad'
1536         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1537              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1538              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1539         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1540              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1541              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1542      END IF      END IF
1543    
1544      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1545      DO i = 1, klon      DO i = 1, klon
1546         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1547         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1825  contains Line 1553  contains
1553         ENDDO         ENDDO
1554      ENDDO      ENDDO
1555    
1556      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1557    
1558      DO i = 1, klon      DO i = 1, klon
1559         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1560      ENDDO      ENDDO
1561    
1562      !moddeblott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1563    
1564      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1565           ! selection des points pour lesquels le shema est actif:
1566         !  selection des points pour lesquels le shema est actif:         igwd = 0
1567         igwd=0         DO i = 1, klon
1568         DO i=1, klon            itest(i) = 0
1569            itest(i)=0            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1570            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN               itest(i) = 1
1571               itest(i)=1               igwd = igwd + 1
1572               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1573            ENDIF            ENDIF
1574         ENDDO         ENDDO
1575    
1576         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1577              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1578              igwd, idx, itest, &              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1579    
1580         !  ajout des tendances         ! ajout des tendances
1581         DO k = 1, llm         DO k = 1, llm
1582            DO i = 1, klon            DO i = 1, klon
1583               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)
# Line 1863  contains Line 1585  contains
1585               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)
1586            ENDDO            ENDDO
1587         ENDDO         ENDDO
1588        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1589    
1590      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1591           ! Sélection des points pour lesquels le schéma est actif :
1592         !  selection des points pour lesquels le shema est actif:         igwd = 0
1593         igwd=0         DO i = 1, klon
1594         DO i=1, klon            itest(i) = 0
1595            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1596            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1597               itest(i)=1               igwd = igwd + 1
1598               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1599            ENDIF            ENDIF
1600         ENDDO         ENDDO
1601    
1602         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1603              rlat, zmea, zstd, zpic, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
             itest, &  
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrli, zvstrli, &  
1604              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1605    
1606         !  ajout des tendances         ! Ajout des tendances :
1607         DO k = 1, llm         DO k = 1, llm
1608            DO i = 1, klon            DO i = 1, klon
1609               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1894  contains Line 1611  contains
1611               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
1612            ENDDO            ENDDO
1613         ENDDO         ENDDO
1614        ENDIF
1615    
1616      ENDIF ! fin de test sur ok_orolf      ! Stress nécessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
1617    
1618      DO i = 1, klon      DO i = 1, klon
1619         zustrph(i)=0.         zustrph(i) = 0.
1620         zvstrph(i)=0.         zvstrph(i) = 0.
1621      ENDDO      ENDDO
1622      DO k = 1, llm      DO k = 1, llm
1623         DO i = 1, klon         DO i = 1, klon
1624            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1625                 (paprs(i, k)-paprs(i, k+1))/rg                 * zmasse(i, k)
1626            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &            zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1627                 (paprs(i, k)-paprs(i, k+1))/rg                 * zmasse(i, k)
1628         ENDDO         ENDDO
1629      ENDDO      ENDDO
1630    
1631      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1632             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1633      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &  
1634           ra, rg, romega, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1635           rlat, rlon, pphis, &           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1636           zustrdr, zustrli, zustrph, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1637           zvstrdr, zvstrli, zvstrph, &  
1638           paprs, u, v, &      ! Calcul des tendances traceurs
1639           aam, torsfc)      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1640             dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
1641      IF (if_ebil >= 2) THEN           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1642         ztit='after orography'           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1643         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     !AA Installation de l'interface online-offline pour traceurs  
   
     !   Calcul  des tendances traceurs  
   
     call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &  
          dtime, u, v, t, paprs, pplay, &  
          pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &  
          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)  
1644    
1645      IF (offline) THEN      IF (offline) THEN
1646           call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1647         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1648         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, 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)  
   
1649      ENDIF      ENDIF
1650    
1651      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1652        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1653             ue, uq)
1654    
1655      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1656    
1657      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
          t_seri, q_seri, u_seri, v_seri, zphi, &  
1658           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1659    
1660      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1661    
1662      !+jld ec_conser      ! conversion Ec -> E thermique
1663      DO k = 1, llm      DO k = 1, llm
1664         DO i = 1, klon         DO i = 1, klon
1665            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1666            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1667                 *(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)
1668            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)
1669            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1670         END DO         END DO
1671      END DO      END DO
1672      !-jld ec_conser  
1673      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1674         ztit='after physic'         tit = 'after physic'
1675         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1676              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1677              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1678         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1679         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1680         !     est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1681         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1682         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1683              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1684              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1685    
1686         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1687    
1688      END IF      END IF
1689    
1690      !   SORTIES      ! SORTIES
   
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
1691    
1692      !cc prw = eau precipitable      !cc prw = eau precipitable
1693      DO i = 1, klon      DO i = 1, klon
1694         prw(i) = 0.         prw(i) = 0.
1695         DO k = 1, llm         DO k = 1, llm
1696            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  
1697         ENDDO         ENDDO
1698      ENDDO      ENDDO
1699    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1700      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1701    
1702      DO k = 1, llm      DO k = 1, llm
1703         DO i = 1, klon         DO i = 1, klon
1704            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1705            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1706            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1707            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)) / dtphys
1708            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)) / dtphys
1709         ENDDO         ENDDO
1710      ENDDO      ENDDO
1711    
1712      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1713         DO iq = 3, nq         DO iq = 3, nqmx
1714            DO  k = 1, llm            DO k = 1, llm
1715               DO  i = 1, klon               DO i = 1, klon
1716                  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)) / dtphys
1717               ENDDO               ENDDO
1718            ENDDO            ENDDO
1719         ENDDO         ENDDO
1720      ENDIF      ENDIF
1721    
1722      ! 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:
   
1723      DO k = 1, llm      DO k = 1, llm
1724         DO i = 1, klon         DO i = 1, klon
1725            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2048  contains Line 1727  contains
1727         ENDDO         ENDDO
1728      ENDDO      ENDDO
1729    
1730      !   Ecriture des sorties      ! Ecriture des sorties
   
1731      call write_histhf      call write_histhf
1732      call write_histday      call write_histday
1733      call write_histins      call write_histins
1734    
1735      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1736      IF (lafin) THEN      IF (lafin) THEN
1737         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1738         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1739              rlat, rlon, pctsrf, ftsol, ftsoil, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1740              tslab, seaice,  & !IM "slab" ocean              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1741              fqsurf, qsol, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1742              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             solsw, sollwdown, dlw, &  
             radsol, frugs, agesno, &  
             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1743      ENDIF      ENDIF
1744    
1745    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  
       !IM 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  
1746    
1747        IF(MOD(itap, ecrit_day) == 0) THEN    contains
          !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  
   
     !***********************************************  
1748    
1749      subroutine write_histday      subroutine write_histday
1750    
1751        !     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
1752          integer itau_w ! pas de temps ecriture
1753    
1754        if (ok_journe) THEN        !------------------------------------------------
   
          ndex2d = 0  
          ndex3d = 0  
   
          ! Champs 2D:  
1755    
1756          if (ok_journe) THEN
1757           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1758             if (nqmx <= 4) then
1759           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1760                     gr_phy_write_3d(wo) * 1e3)
1761                ! (convert "wo" from kDU to DU)
1762             end if
1763           if (ok_sync) then           if (ok_sync) then
1764              call histsync(nid_day)              call histsync(nid_day)
1765           endif           endif
   
1766        ENDIF        ENDIF
1767    
1768      End subroutine write_histday      End subroutine write_histday
# Line 2452  contains Line 1771  contains
1771    
1772      subroutine write_histhf      subroutine write_histhf
1773    
1774        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09
1775    
1776        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1777    
1778        call write_histhf3d        call write_histhf3d
1779    
# Line 2471  contains Line 1787  contains
1787    
1788      subroutine write_histins      subroutine write_histins
1789    
1790        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1791    
1792        real zout        real zout
1793          integer itau_w ! pas de temps ecriture
1794    
1795        !--------------------------------------------------        !--------------------------------------------------
1796    
1797        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1798           ! Champs 2D:           ! Champs 2D:
1799    
1800           zsto = dtime * ecrit_ins           zsto = dtphys * ecrit_ins
1801           zout = dtime * ecrit_ins           zout = dtphys * ecrit_ins
1802           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1803    
1804           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1805           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)
1806           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1807    
1808           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1809           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)
1810           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1811    
1812           DO i = 1, klon           DO i = 1, klon
1813              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1814           ENDDO           ENDDO
1815           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)
1816           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1817    
1818           DO i = 1, klon           DO i = 1, klon
1819              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1820           ENDDO           ENDDO
1821           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)
1822           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1823    
1824           DO i = 1, klon           DO i = 1, klon
1825              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1826           ENDDO           ENDDO
1827           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)
1828           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1829    
1830           DO i = 1, klon           DO i = 1, klon
1831              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1832           ENDDO           ENDDO
1833           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)
1834           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1835    
1836           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)
1837           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1838           !ccIM           !ccIM
1839           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)
1840           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1841    
1842           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)
1843           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1844    
1845           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)
1846           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1847    
1848           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)
1849           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1850    
1851           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)
1852           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1853    
1854           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)
1855           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1856    
1857           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)
1858           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1859    
1860           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)
1861           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1862    
1863           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)
1864           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1865    
1866           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)
1867           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1868    
1869           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)
1870           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1871    
1872           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)
1873           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
1874    
1875           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)
1876           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1877    
1878           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1879           !     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)
1880           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)
1881           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1882    
1883           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)
1884           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1885    
1886           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)
1887           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
1888    
1889           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)
1890           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
1891    
1892           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)
1893           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
1894    
1895           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)
1896           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
1897    
1898           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1899              !XXX              !XXX
1900              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1901              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)
1902              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1903                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1904    
1905              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1906              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)
1907              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1908                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1909    
1910              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1911              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)
1912              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1913                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1914    
1915              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1916              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)
1917              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1918                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1919    
1920              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1921              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)
1922              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1923                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1924    
1925              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1926              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)
1927              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1928                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1929    
1930              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1931              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)
1932              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1933                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1934    
1935              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1936              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)
1937              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1938                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1939    
1940              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1941              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)
1942              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1943                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1944    
1945           END DO           END DO
1946           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)
1947           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1948           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)
1949           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)  
1950    
1951           !IM cf. AM 081204 BEG           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1952             CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1953    
1954           !HBTM2           !HBTM2
1955    
1956           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)
1957           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)
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)  
1958    
1959           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1960           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1961    
1962           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1963           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
               ndex2d)  
1964    
1965           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
1966           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
1967    
1968           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
1969           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
1970    
1971           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
1972           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
1973    
1974           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
1975           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
1976    
1977           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
1978           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
1979    
1980           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
1981           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
1982    
1983           !IM cf. AM 081204 END           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
1984             CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1985    
1986           ! Champs 3D:           ! Champs 3D:
1987    
1988           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)
1989           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1990                iim*(jjm + 1)*llm, ndex3d)  
1991             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
1992           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1993           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &  
1994                iim*(jjm + 1)*llm, ndex3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
1995             CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1996           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
1997           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
1998                iim*(jjm + 1)*llm, ndex3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1999    
2000           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
2001           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2002                iim*(jjm + 1)*llm, ndex3d)  
2003             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
2004           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2005           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &  
2006                iim*(jjm + 1)*llm, ndex3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
2007             CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &  
               iim*(jjm + 1)*llm, ndex3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &  
               iim*(jjm + 1)*llm, ndex3d)  
2008    
2009           if (ok_sync) then           if (ok_sync) then
2010              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2727  contains Line 2017  contains
2017    
2018      subroutine write_histhf3d      subroutine write_histhf3d
2019    
2020        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09
2021    
2022          integer itau_w ! pas de temps ecriture
2023    
2024        ndex2d = 0        !-------------------------------------------------------
       ndex3d = 0  
2025    
2026        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2027    
2028        ! Champs 3D:        ! Champs 3D:
2029    
2030        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)
2031        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2032             iim*(jjm + 1)*llm, ndex3d)  
2033          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)
2034        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2035        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &  
2036             iim*(jjm + 1)*llm, ndex3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
2037          CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2038        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
2039        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
2040             iim*(jjm + 1)*llm, ndex3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &  
            iim*(jjm + 1)*llm, ndex3d)  
2041    
2042        if (nbtr >= 3) then        if (nbtr >= 3) then
2043           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), &
2044                zx_tmp_3d)                zx_tmp_3d)
2045           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)  
2046        end if        end if
2047    
2048        if (ok_sync) then        if (ok_sync) then
# Line 2767  contains Line 2053  contains
2053    
2054    END SUBROUTINE physiq    END SUBROUTINE physiq
2055    
   !****************************************************  
   
   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  
   
2056  end module physiq_m  end module physiq_m
Legend:
Removed from v.6  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.21