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

Diff of /trunk/phylmd/physiq.f

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

revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC revision 49 by guez, Wed Aug 24 11:43:14 2011 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, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, 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.
   
     ! Objet: Moniteur general de la physique du modele  
     !AA      Modifications quant aux traceurs :  
     !AA                  -  uniformisation des parametrisations ds phytrac  
     !AA                  -  stockage des moyennes des champs necessaires  
     !AA                     en mode traceur off-line  
14    
15        use abort_gcm_m, only: abort_gcm
16      USE calendar, only: ymds2ju      USE calendar, only: ymds2ju
17      USE histwrite_m, only: histwrite      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &
18      USE histcom, only: histsync           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
     use dimens_m, only: jjm, iim, llm  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref  
     use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &  
          cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &  
          ok_kzmin  
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
20           cycle_diurne, new_oliq, soil_model           cycle_diurne, new_oliq, soil_model
21      use iniprint, only: prt_level      use clmain_m, only: clmain
     use abort_gcm_m, only: abort_gcm  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
22      use comgeomphy      use comgeomphy
23        use concvl_m, only: concvl
24        use conf_gcm_m, only: raz_date, offline
25        use conf_phys_m, only: conf_phys
26      use ctherm      use ctherm
27      use phytrac_m, only: phytrac      use dimens_m, only: jjm, iim, llm, nqmx
28        use dimphy, only: klon, nbtr
29        use dimsoil, only: nsoilmx
30        use fcttre, only: thermcep, foeew, qsats, qsatl
31        use hgardfou_m, only: hgardfou
32        USE histcom, only: histsync
33        USE histwrite_m, only: histwrite
34        use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra
35        use ini_histhf_m, only: ini_histhf
36        use ini_histday_m, only: ini_histday
37        use ini_histins_m, only: ini_histins
38        use iniprint, only: prt_level
39      use oasis_m      use oasis_m
     use radepsi  
     use radopt  
     use yoethf  
     use ini_hist, only: ini_histhf, ini_histday, ini_histins  
40      use orbite_m, only: orbite, zenang      use orbite_m, only: orbite, zenang
41        use ozonecm_m, only: ozonecm
42      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
     use hgardfou_m, only: hgardfou  
     use conf_phys_m, only: conf_phys  
43      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
44        use phystokenc_m, only: phystokenc
45        use phytrac_m, only: phytrac
46      use qcheck_m, only: qcheck      use qcheck_m, only: qcheck
47      use ozonecm_m, only: ozonecm      use radepsi
48        use radopt
49      ! Declaration des constantes et des fonctions thermodynamiques :      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
50      use fcttre, only: thermcep, foeew, qsats, qsatl      use temps, only: itau_phy, day_ref, annee_ref
51        use yoethf_m
52    
53      ! Variables argument:      ! Variables argument:
54    
     INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)  
   
55      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
56      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
57    
58      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journée en fraction de jour
59      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
60      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
61    
62      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
63      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
64    
65      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
66      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
67    
68      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
69      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
70    
71      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
72    
73      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: u(klon, llm)
74      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      ! vitesse dans la direction X (de O a E) en m/s
75      REAL t(klon, llm)  ! input temperature (K)      
76        REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
77      REAL, intent(in):: qx(klon, llm, nq)      REAL t(klon, llm) ! input temperature (K)
78      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)  
79        REAL, intent(in):: qx(klon, llm, nqmx)
80      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      ! (humidité spécifique et fractions massiques des autres traceurs)
81      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)  
82      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
83      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
84      REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
85      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
86        REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
87        REAL d_ps(klon) ! output tendance physique de la pression au sol
88    
89        LOGICAL:: firstcal = .true.
90    
91      INTEGER nbteta      INTEGER nbteta
92      PARAMETER(nbteta=3)      PARAMETER(nbteta=3)
# Line 104  contains Line 94  contains
94      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
95      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
96    
97      LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
98      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl=.TRUE.)
99      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
100      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust=.FALSE.)
101    
102      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
103      PARAMETER (check=.FALSE.)      PARAMETER (check=.FALSE.)
104      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
105      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus=.FALSE.
106        ! Ajouter artificiellement les stratus
107    
108      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
109      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
# Line 125  contains Line 116  contains
116      logical ok_ocean      logical ok_ocean
117      SAVE ok_ocean      SAVE ok_ocean
118    
119      !IM "slab" ocean      ! "slab" ocean
120      REAL tslab(klon)    !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
121      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
122      REAL seaice(klon)   !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
123      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  
124    
125      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
126      logical, save:: ok_veget      logical, save:: ok_veget
# Line 145  contains Line 134  contains
134      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
135      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region=.FALSE.)
136    
137      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
138      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm+1)
139      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
140      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm+1, nbsrf)
     save q2  
141    
142      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
143      PARAMETER (ivap=1)      PARAMETER (ivap=1)
144      INTEGER iliq          ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
145      PARAMETER (iliq=2)      PARAMETER (iliq=2)
146    
147      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
148      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
149    
150      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
151      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)
152    
153      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
154    
# Line 198  contains Line 184  contains
184      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN=4) clevSTD(nlevSTD)
185      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
186           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
187           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
188    
189      ! prw: precipitable water      ! prw: precipitable water
190      real prw(klon)      real prw(klon)
# Line 267  contains Line 253  contains
253      ! "physiq".)      ! "physiq".)
254    
255      REAL radsol(klon)      REAL radsol(klon)
256      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
257    
258      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
259    
260      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
261    
262      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
263      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
264    
265      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
266      SAVE fevap                 ! evaporation      SAVE fevap ! evaporation
267      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
268      SAVE fluxlat      SAVE fluxlat
269    
270      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
271      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
272    
273      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
274    
275      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
276      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
277    
278      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
279      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
280      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
281      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
282    
283      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
284      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 311  contains Line 295  contains
295      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
296    
297      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
298      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
299    
300      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
301      SAVE run_off_lic_0      SAVE run_off_lic_0
302      !KE43      !KE43
303      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
304    
305      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
306      SAVE bas      SAVE bas
307      SAVE top      SAVE top
308    
309      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
310      SAVE Ma      SAVE Ma
311      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
312      SAVE qcondc      SAVE qcondc
313      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
314      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
315    
316      REAL wd(klon) ! sb      REAL wd(klon) ! sb
317      SAVE wd       ! sb      SAVE wd ! sb
318    
319      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
320    
# Line 339  contains Line 323  contains
323      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
324      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
325    
326      !AA  Pour phytrac      !AA Pour phytrac
327      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
328      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
329      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
330      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
331      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
332      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
333      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
334      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
335    
336      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 367  contains Line 351  contains
351    
352      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
353      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
354      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
355      SAVE dlw      SAVE dlw
356      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
357      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 390  contains Line 374  contains
374      !IM      !IM
375      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
376    
377      SAVE pctsrf                 ! sous-fraction du sol      SAVE pctsrf ! sous-fraction du sol
378      REAL albsol(klon)      REAL albsol(klon)
379      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
380      REAL albsollw(klon)      REAL albsollw(klon)
381      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
382    
383      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
384    
385      ! Declaration des procedures appelees      ! Declaration des procedures appelees
386    
387      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
388      EXTERNAL ajsec     ! ajustement sec      EXTERNAL ajsec ! ajustement sec
     EXTERNAL clmain    ! couche limite  
389      !KE43      !KE43
390      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
391      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
392      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
393      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw ! rayonnements solaire et infrarouge
394      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
395    
396      ! Variables locales      ! Variables locales
397    
# Line 417  contains Line 400  contains
400    
401      save rnebcon, clwcon      save rnebcon, clwcon
402    
403      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
404      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
405      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
406      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
407      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
408      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
409      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
410    
411      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
412      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
413      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
414      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
415    
416      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
417      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
418      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
419      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
420    
421      REAL heat(klon, llm)    ! chauffage solaire      REAL heat(klon, llm) ! chauffage solaire
422      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
423      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL cool(klon, llm) ! refroidissement infrarouge
424      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
425      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
426      real sollwdown(klon)    ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
427      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
428      REAL albpla(klon)      REAL albpla(klon)
429      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
430      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
431      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      ! Le rayonnement n'est pas calcule tous les pas, il faut donc
432      !                      sauvegarder les sorties du rayonnement      ! sauvegarder les sorties du rayonnement
433      SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown      SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown
434      SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0
435    
436      INTEGER itaprad      INTEGER itaprad
437      SAVE itaprad      SAVE itaprad
438    
439      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
440      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
441    
442      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
443      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 479  contains Line 462  contains
462    
463      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
464    
465      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
466      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
467      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
468      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
469      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
470      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
471      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
472      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
473      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
474      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
475      ! Grdeurs de sorties      ! Grdeurs de sorties
476      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
477      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 497  contains Line 480  contains
480    
481      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel (sb):
482    
483      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
484      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
485      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
486      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
487      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
488      SAVE cape      SAVE cape
489    
490      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
491      SAVE pbase      SAVE pbase
492      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
493      SAVE bbase      SAVE bbase
494      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
495      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
496      ! -- convect43:      ! -- convect43:
497      INTEGER ntra              ! nb traceurs pour convect4.3      INTEGER ntra ! nb traceurs pour convect4.3
498      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
499      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
500    
# Line 568  contains Line 551  contains
551    
552      logical ptconv(klon, llm)      logical ptconv(klon, llm)
553    
554      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en série
555    
556      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
557      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 586  contains Line 569  contains
569    
570      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
571    
572      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
573      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)
574    
575      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 603  contains Line 586  contains
586      logical ok_sync      logical ok_sync
587      real date0      real date0
588    
589      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables liees au bilan d'energie et d'enthalpi
590      REAL ztsol(klon)      REAL ztsol(klon)
591      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
592      REAL      d_h_vcol_phy      REAL d_h_vcol_phy
593      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
594      SAVE      d_h_vcol_phy      SAVE d_h_vcol_phy
595      REAL      zero_v(klon)      REAL zero_v(klon)
596      CHARACTER(LEN=15) ztit      CHARACTER(LEN=15) ztit
597      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER ip_ebil ! PRINT level for energy conserv. diag.
598      SAVE      ip_ebil      SAVE ip_ebil
599      DATA      ip_ebil/0/      DATA ip_ebil/0/
600      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
601      !+jld ec_conser      !+jld ec_conser
602      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance du a la conersion Ec -> E thermique
603      REAL ZRCPD      REAL ZRCPD
604      !-jld ec_conser      !-jld ec_conser
605      !IM: t2m, q2m, u10m, v10m      !IM: t2m, q2m, u10m, v10m
606      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
607      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
608      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
609      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
610      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
611      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
612    
613      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
614      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
615    
616      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
617      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
618    
619      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
620      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
621    
622      ! Aerosol optical properties      ! Aerosol optical properties
623      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
624      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
625    
626      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
627      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade=True -ADE=topswad-topsw
628    
629      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
630      ! ok_aie=T ->      ! ok_aie=True ->
631      !        ok_ade=T -AIE=topswai-topswad      ! ok_ade=True -AIE=topswai-topswad
632      !        ok_ade=F -AIE=topswai-topsw      ! ok_ade=F -AIE=topswai-topsw
633    
634      REAL aerindex(klon)       ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
635    
636      ! Parameters      ! Parameters
637      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
638      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
639    
640      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1
641      SAVE u10m      SAVE u10m
# Line 675  contains Line 657  contains
657      SAVE d_v_con      SAVE d_v_con
658      SAVE rnebcon0      SAVE rnebcon0
659      SAVE clwcon0      SAVE clwcon0
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
660    
661      real zmasse(klon, llm)      real zmasse(klon, llm)
662      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
# Line 700  contains Line 672  contains
672         END DO         END DO
673      END IF      END IF
674      ok_sync=.TRUE.      ok_sync=.TRUE.
675      IF (nq  <  2) THEN      IF (nqmx < 2) THEN
676         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
677         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
678      ENDIF      ENDIF
679    
680      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
681         !  initialiser         ! initialiser
682         u10m=0.         u10m=0.
683         v10m=0.         v10m=0.
684         t2m=0.         t2m=0.
685         q2m=0.         q2m=0.
686         ffonte=0.         ffonte=0.
687         fqcalving=0.         fqcalving=0.
688         piz_ae(:, :, :)=0.         piz_ae=0.
689         tau_ae(:, :, :)=0.         tau_ae=0.
690         cg_ae(:, :, :)=0.         cg_ae=0.
691         rain_con(:)=0.         rain_con(:)=0.
692         snow_con(:)=0.         snow_con(:)=0.
693         bl95_b0=0.         bl95_b0=0.
# Line 732  contains Line 704  contains
704         rnebcon = 0.0         rnebcon = 0.0
705         clwcon = 0.0         clwcon = 0.0
706    
707         pblh   =0.        ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
708         plcl   =0.        ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
709         capCL  =0.        ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
710         oliqCL =0.        ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
711         cteiCL =0.        ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
712         pblt   =0.        ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
713         therm  =0.         therm =0.
714         trmb1  =0.        ! deep_cape         trmb1 =0. ! deep_cape
715         trmb2  =0.        ! inhibition         trmb2 =0. ! inhibition
716         trmb3  =0.        ! Point Omega         trmb3 =0. ! Point Omega
717    
718         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
719    
# Line 750  contains Line 722  contains
722         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &
723              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ok_instan, fact_cldcon, facttemps, ok_newmicro, &
724              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
725              ok_ade, ok_aie,  &              ok_ade, ok_aie, &
726              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
727              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
728    
# Line 760  contains Line 732  contains
732         itap = 0         itap = 0
733         itaprad = 0         itaprad = 0
734         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
735              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
736              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
737              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
738              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
739    
740         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
741         q2(:, :, :)=1.e-8         q2=1.e-8
742    
743         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
744    
745         ! on remet le calendrier a zero         ! on remet le calendrier a zero
746         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 784  contains Line 754  contains
754         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
755              ok_region)              ok_region)
756    
757         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
758            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
759            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
760            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
# Line 797  contains Line 767  contains
767         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
768         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
769    
770            print *,"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3 "
771    
772            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
773            DO i = 1, klon            DO i = 1, klon
# Line 810  contains Line 780  contains
780    
781         IF (ok_orodr) THEN         IF (ok_orodr) THEN
782            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
783            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, play)
784         else         else
785            rugoro = 0.            rugoro = 0.
786         ENDIF         ENDIF
787    
788         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
789         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
790    
791         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
792         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
793         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
794         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
795         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
796    
797         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
798    
# Line 831  contains Line 801  contains
801    
802         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
803    
804         !   Initialisation des sorties         ! Initialisation des sorties
805    
806         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
807         call ini_histday(pdtphys, ok_journe, nid_day, nq)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
808         call ini_histins(pdtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
809         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
810         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
811         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 846  contains Line 816  contains
816      DO i = 1, klon      DO i = 1, klon
817         d_ps(i) = 0.0         d_ps(i) = 0.0
818      ENDDO      ENDDO
819      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  
820         DO k = 1, llm         DO k = 1, llm
821            DO i = 1, klon            DO i = 1, klon
822               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
# Line 862  contains Line 825  contains
825      ENDDO      ENDDO
826      da=0.      da=0.
827      mp=0.      mp=0.
828      phi(:, :, :)=0.      phi=0.
829    
830      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
831    
832      DO k = 1, llm      DO k = 1, llm
833         DO i = 1, klon         DO i = 1, klon
834            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
835            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
836            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
837            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
838            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
839            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
840         ENDDO         ENDDO
841      ENDDO      ENDDO
842      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
843         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
844      ELSE      ELSE
845         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
846      ENDIF      ENDIF
# Line 893  contains Line 856  contains
856    
857      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
858         ztit='after dynamic'         ztit='after dynamic'
859         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
860              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
861              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
862         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
863         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
864         !     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.
865         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
866         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
867              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &
868              , zero_v, zero_v, zero_v, ztsol &              d_qt, 0., fs_bound, fq_bound)
             , d_h_vcol+d_h_vcol_phy, d_qt, 0. &  
             , fs_bound, fq_bound )  
869      END IF      END IF
870    
871      ! Diagnostiquer la tendance dynamique      ! Diagnostiquer la tendance dynamique
   
872      IF (ancien_ok) THEN      IF (ancien_ok) THEN
873         DO k = 1, llm         DO k = 1, llm
874            DO i = 1, klon            DO i = 1, klon
875               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
876               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
877            ENDDO            ENDDO
878         ENDDO         ENDDO
879      ELSE      ELSE
# Line 927  contains Line 887  contains
887      ENDIF      ENDIF
888    
889      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
890      DO k = 1, llm      DO k = 1, llm
891         DO i = 1, klon         DO i = 1, klon
892            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
893         ENDDO         ENDDO
894      ENDDO      ENDDO
895    
896      ! Verifier les temperatures      ! Check temperatures:
   
897      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
898    
899      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
900      itap = itap + 1      itap = itap + 1
901      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
902      if (julien == 0) julien = 360      if (julien == 0) julien = 360
# Line 947  contains Line 904  contains
904      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
905    
906      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
907    
908      if (nq >= 5) then      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
909        if (nqmx >= 5) then
910         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
911      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
912         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
# Line 957  contains Line 914  contains
914    
915      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
916    
917      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse
918         DO i = 1, klon         DO i = 1, klon
919            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))
920            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))
# Line 973  contains Line 930  contains
930    
931      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
932         ztit='after reevap'         ztit='after reevap'
933         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
934              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
935              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
936         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
937              , 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, &
938              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
939    
940      END IF      END IF
941    
# Line 1004  contains Line 959  contains
959    
960      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
961      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
962         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
963         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
964      ELSE      ELSE
965         rmu0 = -999.999         rmu0 = -999.999
966      ENDIF      ENDIF
967    
968      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
969      albsol(:)=0.      albsol(:)=0.
970      albsollw(:)=0.      albsollw(:)=0.
971      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1020  contains Line 975  contains
975         ENDDO         ENDDO
976      ENDDO      ENDDO
977    
978      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
979      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
980    
981      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1033  contains Line 988  contains
988    
989      fder = dlw      fder = dlw
990    
991      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
992           t_seri, q_seri, u_seri, v_seri, &  
993           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
994           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
995           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
996           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
997           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
998           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
999           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
1000           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
1001           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
1002           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
          fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
          q2, dsens, devap, &  
          ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
          pblh, capCL, oliqCL, cteiCL, pblT, &  
          therm, trmb1, trmb2, trmb3, plcl, &  
          fqcalving, ffonte, run_off_lic_0, &  
          fluxo, fluxg, tslab, seaice)  
1003    
1004      !XXX Incrementation des flux      ! Incrémentation des flux
1005    
1006      zxfluxt=0.      zxfluxt=0.
1007      zxfluxq=0.      zxfluxq=0.
# Line 1062  contains Line 1010  contains
1010      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1011         DO k = 1, llm         DO k = 1, llm
1012            DO i = 1, klon            DO i = 1, klon
1013               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
1014                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1015               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
1016                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1017               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
1018                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1019               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1020                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1021            END DO            END DO
1022         END DO         END DO
1023      END DO      END DO
# Line 1090  contains Line 1038  contains
1038    
1039      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1040         ztit='after clmain'         ztit='after clmain'
1041         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1042              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1043              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1044         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1045              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1046              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1047      END IF      END IF
1048    
1049      ! Incrementer la temperature du sol      ! Update surface temperature:
1050    
1051      DO i = 1, klon      DO i = 1, klon
1052         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1124  contains Line 1070  contains
1070         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1071         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1072    
1073         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1074              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &
1075              THEN              THEN
1076            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1077                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1078         ENDIF         ENDIF
1079      ENDDO      ENDDO
# Line 1142  contains Line 1088  contains
1088            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1089            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1090            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1091            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1092                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1093            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1094            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 1161  contains Line 1107  contains
1107    
1108      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1109         DO i = 1, klon         DO i = 1, klon
1110            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1111    
1112            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1113            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1114            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1115            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1116            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1117            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1118                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1119            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)
1120            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)
1121            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)
1122            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1123            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1124            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)
1125            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)
1126            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)
1127            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)
1128            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)
1129         ENDDO         ENDDO
1130      ENDDO      ENDDO
1131    
# Line 1193  contains Line 1139  contains
1139    
1140      DO k = 1, llm      DO k = 1, llm
1141         DO i = 1, klon         DO i = 1, klon
1142            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1143                 + d_q_vdf(i, k)/pdtphys                 + d_q_vdf(i, k)/dtphys
1144            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1145                 + d_t_vdf(i, k)/pdtphys                 + d_t_vdf(i, k)/dtphys
1146         ENDDO         ENDDO
1147      ENDDO      ENDDO
1148      IF (check) THEN      IF (check) THEN
# Line 1219  contains Line 1165  contains
1165      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1166         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1167      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1168         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &
1169              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1170              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1171              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1240  contains Line 1186  contains
1186         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1187    
1188         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1189            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1190                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1191                 ema_work1, ema_work2, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1192                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1193                 rain_con, snow_con, ibas_con, itop_con, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1194                 upwd, dnwd, dnwd0, &                 pmflxs, da, phi, mp)
                Ma, cape, tvp, iflagctrl, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
1195    
1196            clwcon0=qcondc            clwcon0=qcondc
1197            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1198         ELSE ! ok_cvl         ELSE
1199            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1200            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &
1201                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1202                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1203                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1280  contains Line 1222  contains
1222               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1223               IF (thermcep) THEN               IF (thermcep) THEN
1224                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1225                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1226                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1227                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1228                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1229               ELSE               ELSE
1230                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1231                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1232                  ELSE                  ELSE
1233                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1234                  ENDIF                  ENDIF
1235               ENDIF               ENDIF
1236               zqsat(i, k)=zx_qs               zqsat(i, k)=zx_qs
1237            ENDDO            ENDDO
1238         ENDDO         ENDDO
1239    
1240         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1241         clwcon0=fact_cldcon*clwcon0         clwcon0=fact_cldcon*clwcon0
1242         call clouds_gno &         call clouds_gno &
1243              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
# Line 1315  contains Line 1257  contains
1257    
1258      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1259         ztit='after convect'         ztit='after convect'
1260         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1261              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1262              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1263         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1264              , 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, &
1265              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1266      END IF      END IF
1267    
1268      IF (check) THEN      IF (check) THEN
# Line 1335  contains Line 1275  contains
1275            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1276                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1277         ENDDO         ENDDO
1278         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1279         print *,"Precip=", zx_t         print *,"Precip=", zx_t
1280      ENDIF      ENDIF
1281      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
# Line 1349  contains Line 1289  contains
1289            ENDDO            ENDDO
1290         ENDDO         ENDDO
1291         DO i = 1, klon         DO i = 1, klon
1292            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtphys) &
1293                 /z_apres(i)                 /z_apres(i)
1294         ENDDO         ENDDO
1295         DO k = 1, llm         DO k = 1, llm
# Line 1372  contains Line 1312  contains
1312      fm_therm=0.      fm_therm=0.
1313      entr_therm=0.      entr_therm=0.
1314    
1315      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1316           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1317           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
     if(iflag_thermals < 0) then  
        !  Rien  
        IF(prt_level>9)print *,'pas de convection'  
     else if(iflag_thermals == 0) then  
        !  Ajustement sec  
        IF(prt_level>9)print *,'ajsec'  
        CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)  
1318         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1319         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1320      else      else
1321         !  Thermiques         ! Thermiques
1322         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1323              , 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)  
1324      endif      endif
1325    
1326      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1327         ztit='after dry_adjust'         ztit='after dry_adjust'
1328         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1329              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1330              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1331      END IF      END IF
1332    
1333      !  Caclul des ratqs      ! Caclul des ratqs
1334    
1335      !   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
1336      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1337      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1338         do k=1, llm         do k=1, llm
1339            do i=1, klon            do i=1, klon
# Line 1419  contains Line 1347  contains
1347         enddo         enddo
1348      endif      endif
1349    
1350      !   ratqs stables      ! ratqs stables
1351      do k=1, llm      do k=1, llm
1352         do i=1, klon         do i=1, klon
1353            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &
1354                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1355         enddo         enddo
1356      enddo      enddo
1357    
1358      !  ratqs final      ! ratqs final
1359      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1360         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1361         !   ratqs final         ! ratqs final
1362         !   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
1363         !   relaxation des ratqs         ! relaxation des ratqs
1364         facteur=exp(-pdtphys*facttemps)         facteur=exp(-dtphys*facttemps)
1365         ratqs=max(ratqs*facteur, ratqss)         ratqs=max(ratqs*facteur, ratqss)
1366         ratqs=max(ratqs, ratqsc)         ratqs=max(ratqs, ratqsc)
1367      else      else
1368         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1369         ratqs=ratqss         ratqs=ratqss
1370      endif      endif
1371    
1372      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1373      ! et le processus de precipitation      ! et le processus de precipitation
1374      CALL fisrtilp(pdtphys, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, &
1375           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1376           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1377           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1472  contains Line 1400  contains
1400            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1401                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1402         ENDDO         ENDDO
1403         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1404         print *,"Precip=", zx_t         print *,"Precip=", zx_t
1405      ENDIF      ENDIF
1406    
1407      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1408         ztit='after fisrt'         ztit='after fisrt'
1409         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1410              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1411              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1412         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1413              , 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, &
1414              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1415      END IF      END IF
1416    
1417      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1418    
1419      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1420    
# Line 1501  contains Line 1427  contains
1427            do k=1, llm            do k=1, llm
1428               do i=1, klon               do i=1, klon
1429                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1430                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1431                          *zmasse(i, k)                          *zmasse(i, k)
1432                  endif                  endif
1433               enddo               enddo
# Line 1509  contains Line 1435  contains
1435         endif         endif
1436    
1437         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1438         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1439              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1440              diafra, dialiq)              diafra, dialiq)
1441         DO k = 1, llm         DO k = 1, llm
# Line 1520  contains Line 1446  contains
1446               ENDIF               ENDIF
1447            ENDDO            ENDDO
1448         ENDDO         ENDDO
   
1449      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1450         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1451         ! 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
1452         ! facttemps         ! facttemps
1453         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1454         do k=1, llm         do k=1, llm
1455            do i=1, klon            do i=1, klon
1456               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k)=rnebcon(i, k)*facteur
# Line 1537  contains Line 1462  contains
1462            enddo            enddo
1463         enddo         enddo
1464    
1465         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1466         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1467         cldliq=cldliq+rnebcon*clwcon         cldliq=cldliq+rnebcon*clwcon
   
1468      ENDIF      ENDIF
1469    
1470      ! 2. NUAGES STARTIFORMES      ! 2. NUAGES STARTIFORMES
1471    
1472      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1473         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1474         DO k = 1, llm         DO k = 1, llm
1475            DO i = 1, klon            DO i = 1, klon
1476               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k).GT.cldfra(i, k)) THEN
# Line 1566  contains Line 1490  contains
1490    
1491      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1492         ztit="after diagcld"         ztit="after diagcld"
1493         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1494              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1495              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1496      END IF      END IF
1497    
1498      ! Calculer l'humidite relative pour diagnostique      ! Calculer l'humidite relative pour diagnostique
# Line 1578  contains Line 1502  contains
1502            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1503            IF (thermcep) THEN            IF (thermcep) THEN
1504               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1505               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1506               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1507               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1508               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1509            ELSE            ELSE
1510               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1511                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1512               ELSE               ELSE
1513                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1514               ENDIF               ENDIF
1515            ENDIF            ENDIF
1516            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
# Line 1601  contains Line 1525  contains
1525         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1526    
1527         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1528         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &
1529              tau_ae, piz_ae, cg_ae, aerindex)              tau_ae, piz_ae, cg_ae, aerindex)
1530      ELSE      ELSE
1531         tau_ae(:, :, :)=0.0         tau_ae=0.0
1532         piz_ae(:, :, :)=0.0         piz_ae=0.0
1533         cg_ae(:, :, :)=0.0         cg_ae=0.0
1534      ENDIF      ENDIF
1535    
1536      ! Calculer les parametres optiques des nuages et quelques      ! Calculer les parametres optiques des nuages et quelques
1537      ! parametres pour diagnostiques:      ! parametres pour diagnostiques:
1538    
1539      if (ok_newmicro) then      if (ok_newmicro) then
1540         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro (paprs, play, ok_newmicro, &
1541              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1542              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1543              flwp, fiwp, flwc, fiwc, &              flwp, fiwp, flwc, fiwc, &
# Line 1622  contains Line 1546  contains
1546              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
1547              cldtaupi, re, fl)              cldtaupi, re, fl)
1548      else      else
1549         CALL nuage (paprs, pplay, &         CALL nuage (paprs, play, &
1550              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1551              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1552              ok_aie, &              ok_aie, &
# Line 1646  contains Line 1570  contains
1570                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1571         ENDDO         ENDDO
1572         ! nouveau rayonnement (compatible Arpege-IFS):         ! nouveau rayonnement (compatible Arpege-IFS):
1573         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1574              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1575              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1576              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1577              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1578              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)  
1579         itaprad = 0         itaprad = 0
1580      ENDIF      ENDIF
1581      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1670  contains Line 1585  contains
1585      DO k = 1, llm      DO k = 1, llm
1586         DO i = 1, klon         DO i = 1, klon
1587            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1588                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.                 + (heat(i, k)-cool(i, k)) * dtphys/86400.
1589         ENDDO         ENDDO
1590      ENDDO      ENDDO
1591    
1592      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1593         ztit='after rad'         ztit='after rad'
1594         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1595              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1596              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1597         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1598              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1599              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1600      END IF      END IF
1601    
1602      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1603      DO i = 1, klon      DO i = 1, klon
1604         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1605         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1710  contains Line 1622  contains
1622      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1623    
1624      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1625         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1626         igwd=0         igwd=0
1627         DO i=1, klon         DO i=1, klon
1628            itest(i)=0            itest(i)=0
# Line 1721  contains Line 1633  contains
1633            ENDIF            ENDIF
1634         ENDDO         ENDDO
1635    
1636         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, &
1637              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1638              igwd, idx, itest, &              igwd, idx, itest, &
1639              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
1640              zulow, zvlow, zustrdr, zvstrdr, &              zulow, zvlow, zustrdr, zvstrdr, &
1641              d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
1642    
1643         !  ajout des tendances         ! ajout des tendances
1644         DO k = 1, llm         DO k = 1, llm
1645            DO i = 1, klon            DO i = 1, klon
1646               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 1739  contains Line 1651  contains
1651      ENDIF      ENDIF
1652    
1653      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1654           ! selection des points pour lesquels le shema est actif:
        !  selection des points pour lesquels le shema est actif:  
1655         igwd=0         igwd=0
1656         DO i=1, klon         DO i=1, klon
1657            itest(i)=0            itest(i)=0
# Line 1751  contains Line 1662  contains
1662            ENDIF            ENDIF
1663         ENDDO         ENDDO
1664    
1665         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1666              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, &  
1667              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1668    
1669         !  ajout des tendances         ! ajout des tendances
1670         DO k = 1, llm         DO k = 1, llm
1671            DO i = 1, klon            DO i = 1, klon
1672               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 1766  contains Line 1674  contains
1674               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)
1675            ENDDO            ENDDO
1676         ENDDO         ENDDO
1677        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1678    
1679      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1680    
# Line 1777  contains Line 1684  contains
1684      ENDDO      ENDDO
1685      DO k = 1, llm      DO k = 1, llm
1686         DO i = 1, klon         DO i = 1, klon
1687            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1688            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)
1689         ENDDO         ENDDO
1690      ENDDO      ENDDO
1691    
1692      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1693    
1694      CALL aaam_bud(27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &
1695           ra, rg, romega, &           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &
          rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
1696           aam, torsfc)           aam, torsfc)
1697    
1698      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1699         ztit='after orography'         ztit='after orography'
1700         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1701              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1702              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1703      END IF      END IF
1704    
1705      ! Calcul  des tendances traceurs      ! Calcul des tendances traceurs
1706      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &
1707           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &
1708           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1709           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &
1710           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1711           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           tr_seri, zmasse)
1712    
1713      IF (offline) THEN      IF (offline) THEN
1714         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1715              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1716              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1717      ENDIF      ENDIF
1718    
1719      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
# Line 1819  contains Line 1722  contains
1722    
1723      ! diag. bilKP      ! diag. bilKP
1724    
1725      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, &  
1726           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1727    
1728      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1832  contains Line 1734  contains
1734            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1735                 *(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)
1736            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)
1737            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k)/dtphys
1738         END DO         END DO
1739      END DO      END DO
1740      !-jld ec_conser      !-jld ec_conser
1741      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1742         ztit='after physic'         ztit='after physic'
1743         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1744              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1745              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1746         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1747         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1748         !     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.
1749         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1750         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1751              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1752              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1753    
1754         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy=d_h_vcol
1755    
1756      END IF      END IF
1757    
1758      !   SORTIES      ! SORTIES
1759    
1760      !cc prw = eau precipitable      !cc prw = eau precipitable
1761      DO i = 1, klon      DO i = 1, klon
# Line 1869  contains Line 1769  contains
1769    
1770      DO k = 1, llm      DO k = 1, llm
1771         DO i = 1, klon         DO i = 1, klon
1772            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1773            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1774            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1775            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1776            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1777         ENDDO         ENDDO
1778      ENDDO      ENDDO
1779    
1780      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1781         DO iq = 3, nq         DO iq = 3, nqmx
1782            DO  k = 1, llm            DO k = 1, llm
1783               DO  i = 1, klon               DO i = 1, klon
1784                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
1785               ENDDO               ENDDO
1786            ENDDO            ENDDO
1787         ENDDO         ENDDO
# Line 1895  contains Line 1795  contains
1795         ENDDO         ENDDO
1796      ENDDO      ENDDO
1797    
1798      !   Ecriture des sorties      ! Ecriture des sorties
1799      call write_histhf      call write_histhf
1800      call write_histday      call write_histday
1801      call write_histins      call write_histins
# Line 1903  contains Line 1803  contains
1803      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1804      IF (lafin) THEN      IF (lafin) THEN
1805         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1806         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1807              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1808              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1809              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1810              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1811      ENDIF      ENDIF
1812    
1813        firstcal = .FALSE.
1814    
1815    contains    contains
1816    
1817      subroutine write_histday      subroutine write_histday
1818    
1819        use grid_change, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1820        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1821    
1822        !------------------------------------------------        !------------------------------------------------
1823    
1824        if (ok_journe) THEN        if (ok_journe) THEN
1825           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1826           if (nq <= 4) then           if (nqmx <= 4) then
1827              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1828                   gr_phy_write_3d(wo) * 1e3)                   gr_phy_write_3d(wo) * 1e3)
1829              ! (convert "wo" from kDU to DU)              ! (convert "wo" from kDU to DU)
# Line 1939  contains Line 1839  contains
1839    
1840      subroutine write_histhf      subroutine write_histhf
1841    
1842        ! 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
1843    
1844        !------------------------------------------------        !------------------------------------------------
1845    
# Line 1955  contains Line 1855  contains
1855    
1856      subroutine write_histins      subroutine write_histins
1857    
1858        ! 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
1859    
1860        real zout        real zout
1861        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1862    
1863        !--------------------------------------------------        !--------------------------------------------------
1864    
1865        IF (ok_instan) THEN        IF (ok_instan) THEN
1866           ! Champs 2D:           ! Champs 2D:
1867    
1868           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1869           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1870           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1871    
1872           i = NINT(zout/zsto)           i = NINT(zout/zsto)
# Line 2044  contains Line 1944  contains
1944           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1945    
1946           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
1947           !     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)
1948           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)
1949           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1950    
# Line 2065  contains Line 1965  contains
1965    
1966           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1967              !XXX              !XXX
1968              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1969              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)
1970              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1971                   zx_tmp_2d)                   zx_tmp_2d)
1972    
1973              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1974              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)
1975              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1976                   zx_tmp_2d)                   zx_tmp_2d)
1977    
1978              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1979              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)
1980              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1981                   zx_tmp_2d)                   zx_tmp_2d)
1982    
1983              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1984              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)
1985              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1986                   zx_tmp_2d)                   zx_tmp_2d)
1987    
1988              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1989              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)
1990              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1991                   zx_tmp_2d)                   zx_tmp_2d)
1992    
1993              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1994              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1995              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1996                   zx_tmp_2d)                   zx_tmp_2d)
1997    
1998              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1999              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)
2000              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2001                   zx_tmp_2d)                   zx_tmp_2d)
2002    
2003              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
2004              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)
2005              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2006                   zx_tmp_2d)                   zx_tmp_2d)
2007    
2008              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
2009              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)
2010              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2011                   zx_tmp_2d)                   zx_tmp_2d)
# Line 2169  contains Line 2069  contains
2069           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)
2070           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2071    
2072           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), play, zx_tmp_3d)
2073           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2074    
2075           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)
# Line 2189  contains Line 2089  contains
2089    
2090      subroutine write_histhf3d      subroutine write_histhf3d
2091    
2092        ! 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
2093    
2094        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
2095    
2096        !-------------------------------------------------------        !-------------------------------------------------------
2097    

Legend:
Removed from v.31  
changed lines
  Added in v.49

  ViewVC Help
Powered by ViewVC 1.1.21