/[lmdze]/trunk/libf/phylmd/physiq.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/physiq.f90

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

revision 46 by guez, Tue Feb 22 13:49:36 2011 UTC revision 47 by guez, Fri Jul 1 15:00:48 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(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, version 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      ! Objet : moniteur général de la physique du modèle
   
     ! 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      use abort_gcm_m, only: abort_gcm
16      USE calendar, only: ymds2ju      USE calendar, only: ymds2ju
17      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &
18           cdmmax, cdhmax, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
          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 clmain_m, only: clmain      use clmain_m, only: clmain
22      use comgeomphy      use comgeomphy
23        use concvl_m, only: concvl
24      use conf_gcm_m, only: raz_date, offline      use conf_gcm_m, only: raz_date, offline
25      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
26      use ctherm      use ctherm
# Line 42  contains Line 30  contains
30      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
31      USE histcom, only: histsync      USE histcom, only: histsync
32      USE histwrite_m, only: histwrite      USE histwrite_m, only: histwrite
33      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra
          clnsurf, epsfra  
34      use ini_histhf_m, only: ini_histhf      use ini_histhf_m, only: ini_histhf
35      use ini_histday_m, only: ini_histday      use ini_histday_m, only: ini_histday
36      use ini_histins_m, only: ini_histins      use ini_histins_m, only: ini_histins
# Line 70  contains Line 57  contains
57      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
58      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
59    
60      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
61      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
62      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
63    
64      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
65      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
66    
67      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
68      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
69    
70      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
71      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
72    
73      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
74    
75      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: u(klon, llm)
76      REAL, intent(in):: v(klon, llm)  ! vitesse Y (de S a N) en m/s      ! vitesse dans la direction X (de O a E) en m/s
77      REAL t(klon, llm)  ! input temperature (K)      
78        REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
79        REAL t(klon, llm) ! input temperature (K)
80    
81      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
82      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
83    
84      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
85      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
86      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
87      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm) ! output tendance physique de "t" (K/s)
88      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
89      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon) ! output tendance physique de la pression au sol
90    
91      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
92    
# Line 107  contains Line 96  contains
96      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
97      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
98    
99      LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
100      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl=.TRUE.)
101      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
102      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust=.FALSE.)
# Line 129  contains Line 118  contains
118      SAVE ok_ocean      SAVE ok_ocean
119    
120      !IM "slab" ocean      !IM "slab" ocean
121      REAL tslab(klon)    !Temperature du slab-ocean      REAL tslab(klon) !Temperature du slab-ocean
122      SAVE tslab      SAVE tslab
123      REAL seaice(klon)   !glace de mer (kg/m2)      REAL seaice(klon) !glace de mer (kg/m2)
124      SAVE seaice      SAVE seaice
125      REAL fluxo(klon)    !flux turbulents ocean-glace de mer      REAL fluxo(klon) !flux turbulents ocean-glace de mer
126      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon) !flux turbulents ocean-atmosphere
127    
128      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
129      logical, save:: ok_veget      logical, save:: ok_veget
# Line 148  contains Line 137  contains
137      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
138      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region=.FALSE.)
139    
140      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
141      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm+1)
142      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
143      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm+1, nbsrf)
     save q2  
144    
145      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
146      PARAMETER (ivap=1)      PARAMETER (ivap=1)
147      INTEGER iliq          ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
148      PARAMETER (iliq=2)      PARAMETER (iliq=2)
149    
150      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL t_ancien(klon, llm), q_ancien(klon, llm)
# Line 165  contains Line 153  contains
153      SAVE ancien_ok      SAVE ancien_ok
154    
155      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
156      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)
157    
158      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
159    
# Line 201  contains Line 189  contains
189      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN=4) clevSTD(nlevSTD)
190      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
191           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
192           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
193    
194      ! prw: precipitable water      ! prw: precipitable water
195      real prw(klon)      real prw(klon)
# Line 270  contains Line 258  contains
258      ! "physiq".)      ! "physiq".)
259    
260      REAL radsol(klon)      REAL radsol(klon)
261      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
262    
263      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
264    
265      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
266      SAVE ftsol                  ! temperature du sol      SAVE ftsol ! temperature du sol
267    
268      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL ftsoil(klon, nsoilmx, nbsrf)
269      SAVE ftsoil                 ! temperature dans le sol      SAVE ftsoil ! temperature dans le sol
270    
271      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
272      SAVE fevap                 ! evaporation      SAVE fevap ! evaporation
273      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
274      SAVE fluxlat      SAVE fluxlat
275    
276      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
277      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
278    
279      REAL qsol(klon)      REAL qsol(klon)
280      SAVE qsol                  ! hauteur d'eau dans le sol      SAVE qsol ! hauteur d'eau dans le sol
281    
282      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
283      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
284    
285      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
286      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
287      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
288      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
289    
290      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
291      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 314  contains Line 302  contains
302      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
303    
304      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
305      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
306    
307      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
308      SAVE run_off_lic_0      SAVE run_off_lic_0
309      !KE43      !KE43
310      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
311    
312      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
313      SAVE bas      SAVE bas
314      SAVE top      SAVE top
315    
316      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
317      SAVE Ma      SAVE Ma
318      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
319      SAVE qcondc      SAVE qcondc
320      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
321      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
322    
323      REAL wd(klon) ! sb      REAL wd(klon) ! sb
324      SAVE wd       ! sb      SAVE wd ! sb
325    
326      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
327    
# Line 342  contains Line 330  contains
330      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
331      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
332    
333      !AA  Pour phytrac      !AA Pour phytrac
334      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
335      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
336      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
337      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
338      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
339      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
340      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
341      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
342    
343      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 370  contains Line 358  contains
358    
359      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
360      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
361      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
362      SAVE dlw      SAVE dlw
363      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
364      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 393  contains Line 381  contains
381      !IM      !IM
382      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
383    
384      SAVE pctsrf                 ! sous-fraction du sol      SAVE pctsrf ! sous-fraction du sol
385      REAL albsol(klon)      REAL albsol(klon)
386      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
387      REAL albsollw(klon)      REAL albsollw(klon)
388      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
389    
390      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
391    
392      ! Declaration des procedures appelees      ! Declaration des procedures appelees
393    
394      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
395      EXTERNAL ajsec     ! ajustement sec      EXTERNAL ajsec ! ajustement sec
396      !KE43      !KE43
397      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
398      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
399      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
400      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw ! rayonnements solaire et infrarouge
401      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
402    
403      ! Variables locales      ! Variables locales
404    
# Line 419  contains Line 407  contains
407    
408      save rnebcon, clwcon      save rnebcon, clwcon
409    
410      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
411      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
412      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
413      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
414      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
415      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
416      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
417    
418      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
419      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
420      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
421      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
422    
423      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
424      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
425      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
426      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
427    
428      REAL heat(klon, llm)    ! chauffage solaire      REAL heat(klon, llm) ! chauffage solaire
429      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
430      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL cool(klon, llm) ! refroidissement infrarouge
431      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
432      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
433      real sollwdown(klon)    ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
434      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
435      REAL albpla(klon)      REAL albpla(klon)
436      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
437      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
438      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      ! Le rayonnement n'est pas calcule tous les pas, il faut donc
439      !                      sauvegarder les sorties du rayonnement      ! sauvegarder les sorties du rayonnement
440      SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown      SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown
441      SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0
442    
443      INTEGER itaprad      INTEGER itaprad
444      SAVE itaprad      SAVE itaprad
# Line 481  contains Line 469  contains
469    
470      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
471    
472      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL pblh(klon, nbsrf) ! Hauteur de couche limite
473      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL plcl(klon, nbsrf) ! Niveau de condensation de la CLA
474      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL capCL(klon, nbsrf) ! CAPE de couche limite
475      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
476      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
477      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL pblt(klon, nbsrf) ! T a la Hauteur de couche limite
478      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
479      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL trmb1(klon, nbsrf) ! deep_cape
480      REAL trmb2(klon, nbsrf)          ! inhibition      REAL trmb2(klon, nbsrf) ! inhibition
481      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL trmb3(klon, nbsrf) ! Point Omega
482      ! Grdeurs de sorties      ! Grdeurs de sorties
483      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
484      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 499  contains Line 487  contains
487    
488      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel (sb):
489    
490      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
491      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
492      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
493      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
494      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
495      SAVE cape      SAVE cape
496    
497      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
498      SAVE pbase      SAVE pbase
499      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
500      SAVE bbase      SAVE bbase
501      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
502      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
503      ! -- convect43:      ! -- convect43:
504      INTEGER ntra              ! nb traceurs pour convect4.3      INTEGER ntra ! nb traceurs pour convect4.3
505      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
506      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
507    
# Line 588  contains Line 576  contains
576    
577      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
578    
579      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
580      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)
581    
582      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 605  contains Line 593  contains
593      logical ok_sync      logical ok_sync
594      real date0      real date0
595    
596      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables liees au bilan d'energie et d'enthalpi
597      REAL ztsol(klon)      REAL ztsol(klon)
598      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
599      REAL      d_h_vcol_phy      REAL d_h_vcol_phy
600      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
601      SAVE      d_h_vcol_phy      SAVE d_h_vcol_phy
602      REAL      zero_v(klon)      REAL zero_v(klon)
603      CHARACTER(LEN=15) ztit      CHARACTER(LEN=15) ztit
604      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER ip_ebil ! PRINT level for energy conserv. diag.
605      SAVE      ip_ebil      SAVE ip_ebil
606      DATA      ip_ebil/0/      DATA ip_ebil/0/
607      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
608      !+jld ec_conser      !+jld ec_conser
609      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
610      REAL ZRCPD      REAL ZRCPD
611      !-jld ec_conser      !-jld ec_conser
612      !IM: t2m, q2m, u10m, v10m      !IM: t2m, q2m, u10m, v10m
613      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) !temperature, humidite a 2m
614      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
615      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
616      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
617      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
618      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
619    
620      REAL sulfate_pi(klon, llm)      REAL sulfate_pi(klon, llm)
# Line 636  contains Line 624  contains
624      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
625      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
626    
627      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
628      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
629    
630      ! Aerosol optical properties      ! Aerosol optical properties
631      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
# Line 648  contains Line 636  contains
636    
637      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
638      ! ok_aie=T ->      ! ok_aie=T ->
639      !        ok_ade=T -AIE=topswai-topswad      ! ok_ade=T -AIE=topswai-topswad
640      !        ok_ade=F -AIE=topswai-topsw      ! ok_ade=F -AIE=topswai-topsw
641    
642      REAL aerindex(klon)       ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
643    
644      ! Parameters      ! Parameters
645      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
646      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
647    
648      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1
649      SAVE u10m      SAVE u10m
# Line 702  contains Line 690  contains
690         END DO         END DO
691      END IF      END IF
692      ok_sync=.TRUE.      ok_sync=.TRUE.
693      IF (nqmx  <  2) THEN      IF (nqmx < 2) THEN
694         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
695         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
696      ENDIF      ENDIF
697    
698      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
699         !  initialiser         ! initialiser
700         u10m=0.         u10m=0.
701         v10m=0.         v10m=0.
702         t2m=0.         t2m=0.
703         q2m=0.         q2m=0.
704         ffonte=0.         ffonte=0.
705         fqcalving=0.         fqcalving=0.
706         piz_ae(:, :, :)=0.         piz_ae=0.
707         tau_ae(:, :, :)=0.         tau_ae=0.
708         cg_ae(:, :, :)=0.         cg_ae=0.
709         rain_con(:)=0.         rain_con(:)=0.
710         snow_con(:)=0.         snow_con(:)=0.
711         bl95_b0=0.         bl95_b0=0.
# Line 734  contains Line 722  contains
722         rnebcon = 0.0         rnebcon = 0.0
723         clwcon = 0.0         clwcon = 0.0
724    
725         pblh   =0.        ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
726         plcl   =0.        ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
727         capCL  =0.        ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
728         oliqCL =0.        ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
729         cteiCL =0.        ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
730         pblt   =0.        ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
731         therm  =0.         therm =0.
732         trmb1  =0.        ! deep_cape         trmb1 =0. ! deep_cape
733         trmb2  =0.        ! inhibition         trmb2 =0. ! inhibition
734         trmb3  =0.        ! Point Omega         trmb3 =0. ! Point Omega
735    
736         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
737    
# Line 752  contains Line 740  contains
740         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &
741              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ok_instan, fact_cldcon, facttemps, ok_newmicro, &
742              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
743              ok_ade, ok_aie,  &              ok_ade, ok_aie, &
744              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
745              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
746    
# Line 766  contains Line 754  contains
754              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
755              dlw, radsol, frugs, agesno, &              dlw, radsol, frugs, agesno, &
756              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
757              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
758              run_off_lic_0)              run_off_lic_0)
759    
760         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
761         q2(:, :, :)=1.e-8         q2=1.e-8
762    
763         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT( 86400. / dtphys / nbapp_rad)
764    
765         ! on remet le calendrier a zero         ! on remet le calendrier a zero
766         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 786  contains Line 774  contains
774         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
775              ok_region)              ok_region)
776    
777         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
778            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
779            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
780            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
# Line 799  contains Line 787  contains
787         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
788         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
789    
790            print *,"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3 "
791    
792            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
793            DO i = 1, klon            DO i = 1, klon
# Line 812  contains Line 800  contains
800    
801         IF (ok_orodr) THEN         IF (ok_orodr) THEN
802            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
803            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, play)
804         else         else
805            rugoro = 0.            rugoro = 0.
806         ENDIF         ENDIF
807    
808         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
809         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
810    
811         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
812         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
813         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
814         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
815         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
816    
817         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
818    
# Line 833  contains Line 821  contains
821    
822         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
823    
824         !   Initialisation des sorties         ! Initialisation des sorties
825    
826         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
827         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
828         call ini_histins(pdtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
829         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
830         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
831         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 864  contains Line 852  contains
852      ENDDO      ENDDO
853      da=0.      da=0.
854      mp=0.      mp=0.
855      phi(:, :, :)=0.      phi=0.
856    
857      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
858    
859      DO k = 1, llm      DO k = 1, llm
860         DO i = 1, klon         DO i = 1, klon
861            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
862            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
863            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
864            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
865            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
866            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
867         ENDDO         ENDDO
# Line 895  contains Line 883  contains
883    
884      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
885         ztit='after dynamic'         ztit='after dynamic'
886         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
887              , 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, &
888              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
889         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
890         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
891         !     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.
892         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
893         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
894              , 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, &
895              , 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 )  
896      END IF      END IF
897    
898      ! Diagnostiquer la tendance dynamique      ! Diagnostiquer la tendance dynamique
# Line 914  contains Line 900  contains
900      IF (ancien_ok) THEN      IF (ancien_ok) THEN
901         DO k = 1, llm         DO k = 1, llm
902            DO i = 1, klon            DO i = 1, klon
903               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
904               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
905            ENDDO            ENDDO
906         ENDDO         ENDDO
907      ELSE      ELSE
# Line 959  contains Line 945  contains
945    
946      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
947    
948      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse
949         DO i = 1, klon         DO i = 1, klon
950            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))
951            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))
# Line 975  contains Line 961  contains
961    
962      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
963         ztit='after reevap'         ztit='after reevap'
964         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
965              , 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, &
966              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
967         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
968              , 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, &
969              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
970    
971      END IF      END IF
972    
# Line 1006  contains Line 990  contains
990    
991      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
992      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
993         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
994         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
995      ELSE      ELSE
996         rmu0 = -999.999         rmu0 = -999.999
997      ENDIF      ENDIF
998    
999      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
1000      albsol(:)=0.      albsol(:)=0.
1001      albsollw(:)=0.      albsollw(:)=0.
1002      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1022  contains Line 1006  contains
1006         ENDDO         ENDDO
1007      ENDDO      ENDDO
1008    
1009      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
1010      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
1011    
1012      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1037  contains Line 1021  contains
1021    
1022      ! Couche limite:      ! Couche limite:
1023    
1024      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
1025           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
1026           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
1027           qsol, paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
1028           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
1029           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
1030           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
# Line 1057  contains Line 1041  contains
1041      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1042         DO k = 1, llm         DO k = 1, llm
1043            DO i = 1, klon            DO i = 1, klon
1044               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
1045                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)
1046               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
1047                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)
1048               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
1049                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)
1050               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1051                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)
1052            END DO            END DO
1053         END DO         END DO
# Line 1085  contains Line 1069  contains
1069    
1070      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1071         ztit='after clmain'         ztit='after clmain'
1072         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1073              , 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, &
1074              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1075         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1076              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1077              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1078      END IF      END IF
1079    
1080      ! Incrementer la temperature du sol      ! Incrementer la temperature du sol
# Line 1119  contains Line 1101  contains
1101         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1102         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1103    
1104         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1105              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &
1106              THEN              THEN
1107            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1108                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1109         ENDIF         ENDIF
1110      ENDDO      ENDDO
# Line 1137  contains Line 1119  contains
1119            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1120            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1121            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1122            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1123                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1124            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1125            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 1156  contains Line 1138  contains
1138    
1139      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1140         DO i = 1, klon         DO i = 1, klon
1141            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1142    
1143            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1144            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1145            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1146            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1147            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1148            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1149                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1150            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)
1151            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)
1152            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)
1153            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1154            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1155            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)
1156            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)
1157            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)
1158            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)
1159            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)
1160         ENDDO         ENDDO
1161      ENDDO      ENDDO
1162    
# Line 1188  contains Line 1170  contains
1170    
1171      DO k = 1, llm      DO k = 1, llm
1172         DO i = 1, klon         DO i = 1, klon
1173            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1174                 + d_q_vdf(i, k)/pdtphys                 + d_q_vdf(i, k)/dtphys
1175            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1176                 + d_t_vdf(i, k)/pdtphys                 + d_t_vdf(i, k)/dtphys
1177         ENDDO         ENDDO
1178      ENDDO      ENDDO
1179      IF (check) THEN      IF (check) THEN
# Line 1214  contains Line 1196  contains
1196      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1197         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1198      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1199         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &
1200              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1201              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1202              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1235  contains Line 1217  contains
1217         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1218    
1219         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1220            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1221                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1222                 ema_work1, ema_work2, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1223                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1224                 rain_con, snow_con, ibas_con, itop_con, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1225                 upwd, dnwd, dnwd0, &                 pmflxs, da, phi, mp)
                Ma, cape, tvp, iflagctrl, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
1226    
1227            clwcon0=qcondc            clwcon0=qcondc
1228            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1229         ELSE ! ok_cvl         ELSE
1230            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1231            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &
1232                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1233                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1234                 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 1275  contains Line 1253  contains
1253               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1254               IF (thermcep) THEN               IF (thermcep) THEN
1255                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1256                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1257                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1258                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1259                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1260               ELSE               ELSE
1261                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1262                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1263                  ELSE                  ELSE
1264                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1265                  ENDIF                  ENDIF
1266               ENDIF               ENDIF
1267               zqsat(i, k)=zx_qs               zqsat(i, k)=zx_qs
1268            ENDDO            ENDDO
1269         ENDDO         ENDDO
1270    
1271         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1272         clwcon0=fact_cldcon*clwcon0         clwcon0=fact_cldcon*clwcon0
1273         call clouds_gno &         call clouds_gno &
1274              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
# Line 1310  contains Line 1288  contains
1288    
1289      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1290         ztit='after convect'         ztit='after convect'
1291         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1292              , 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, &
1293              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1294         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1295              , 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, &
1296              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1297      END IF      END IF
1298    
1299      IF (check) THEN      IF (check) THEN
# Line 1330  contains Line 1306  contains
1306            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1307                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1308         ENDDO         ENDDO
1309         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1310         print *,"Precip=", zx_t         print *,"Precip=", zx_t
1311      ENDIF      ENDIF
1312      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
# Line 1344  contains Line 1320  contains
1320            ENDDO            ENDDO
1321         ENDDO         ENDDO
1322         DO i = 1, klon         DO i = 1, klon
1323            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) &
1324                 /z_apres(i)                 /z_apres(i)
1325         ENDDO         ENDDO
1326         DO k = 1, llm         DO k = 1, llm
# Line 1367  contains Line 1343  contains
1343      fm_therm=0.      fm_therm=0.
1344      entr_therm=0.      entr_therm=0.
1345    
1346      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1347           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1348           , 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)  
1349         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1350         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1351      else      else
1352         !  Thermiques         ! Thermiques
1353         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1354              , 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)  
1355      endif      endif
1356    
1357      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1358         ztit='after dry_adjust'         ztit='after dry_adjust'
1359         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1360              , 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, &
1361              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1362      END IF      END IF
1363    
1364      !  Caclul des ratqs      ! Caclul des ratqs
1365    
1366      !   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
1367      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1368      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1369         do k=1, llm         do k=1, llm
1370            do i=1, klon            do i=1, klon
# Line 1414  contains Line 1378  contains
1378         enddo         enddo
1379      endif      endif
1380    
1381      !   ratqs stables      ! ratqs stables
1382      do k=1, llm      do k=1, llm
1383         do i=1, klon         do i=1, klon
1384            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &
1385                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1386         enddo         enddo
1387      enddo      enddo
1388    
1389      !  ratqs final      ! ratqs final
1390      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1391         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1392         !   ratqs final         ! ratqs final
1393         !   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
1394         !   relaxation des ratqs         ! relaxation des ratqs
1395         facteur=exp(-pdtphys*facttemps)         facteur=exp(-dtphys*facttemps)
1396         ratqs=max(ratqs*facteur, ratqss)         ratqs=max(ratqs*facteur, ratqss)
1397         ratqs=max(ratqs, ratqsc)         ratqs=max(ratqs, ratqsc)
1398      else      else
1399         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1400         ratqs=ratqss         ratqs=ratqss
1401      endif      endif
1402    
1403      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1404      ! et le processus de precipitation      ! et le processus de precipitation
1405      CALL fisrtilp(pdtphys, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, &
1406           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1407           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1408           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1467  contains Line 1431  contains
1431            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1432                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1433         ENDDO         ENDDO
1434         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1435         print *,"Precip=", zx_t         print *,"Precip=", zx_t
1436      ENDIF      ENDIF
1437    
1438      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1439         ztit='after fisrt'         ztit='after fisrt'
1440         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1441              , 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, &
1442              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1443         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1444              , 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, &
1445              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1446      END IF      END IF
1447    
1448      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1449    
1450      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1451    
# Line 1496  contains Line 1458  contains
1458            do k=1, llm            do k=1, llm
1459               do i=1, klon               do i=1, klon
1460                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1461                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1462                          *zmasse(i, k)                          *zmasse(i, k)
1463                  endif                  endif
1464               enddo               enddo
# Line 1504  contains Line 1466  contains
1466         endif         endif
1467    
1468         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1469         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1470              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1471              diafra, dialiq)              diafra, dialiq)
1472         DO k = 1, llm         DO k = 1, llm
# Line 1520  contains Line 1482  contains
1482         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1483         ! 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
1484         ! facttemps         ! facttemps
1485         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1486         do k=1, llm         do k=1, llm
1487            do i=1, klon            do i=1, klon
1488               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k)=rnebcon(i, k)*facteur
# Line 1532  contains Line 1494  contains
1494            enddo            enddo
1495         enddo         enddo
1496    
1497         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1498         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1499         cldliq=cldliq+rnebcon*clwcon         cldliq=cldliq+rnebcon*clwcon
1500    
# Line 1541  contains Line 1503  contains
1503      ! 2. NUAGES STARTIFORMES      ! 2. NUAGES STARTIFORMES
1504    
1505      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1506         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1507         DO k = 1, llm         DO k = 1, llm
1508            DO i = 1, klon            DO i = 1, klon
1509               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k).GT.cldfra(i, k)) THEN
# Line 1561  contains Line 1523  contains
1523    
1524      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1525         ztit="after diagcld"         ztit="after diagcld"
1526         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1527              , 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, &
1528              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1529      END IF      END IF
1530    
1531      ! Calculer l'humidite relative pour diagnostique      ! Calculer l'humidite relative pour diagnostique
# Line 1573  contains Line 1535  contains
1535            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1536            IF (thermcep) THEN            IF (thermcep) THEN
1537               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1538               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1539               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1540               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1541               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1542            ELSE            ELSE
1543               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1544                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1545               ELSE               ELSE
1546                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1547               ENDIF               ENDIF
1548            ENDIF            ENDIF
1549            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
# Line 1596  contains Line 1558  contains
1558         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1559    
1560         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1561         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &
1562              tau_ae, piz_ae, cg_ae, aerindex)              tau_ae, piz_ae, cg_ae, aerindex)
1563      ELSE      ELSE
1564         tau_ae(:, :, :)=0.0         tau_ae=0.0
1565         piz_ae(:, :, :)=0.0         piz_ae=0.0
1566         cg_ae(:, :, :)=0.0         cg_ae=0.0
1567      ENDIF      ENDIF
1568    
1569      ! Calculer les parametres optiques des nuages et quelques      ! Calculer les parametres optiques des nuages et quelques
1570      ! parametres pour diagnostiques:      ! parametres pour diagnostiques:
1571    
1572      if (ok_newmicro) then      if (ok_newmicro) then
1573         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro (paprs, play, ok_newmicro, &
1574              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1575              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1576              flwp, fiwp, flwc, fiwc, &              flwp, fiwp, flwc, fiwc, &
# Line 1617  contains Line 1579  contains
1579              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
1580              cldtaupi, re, fl)              cldtaupi, re, fl)
1581      else      else
1582         CALL nuage (paprs, pplay, &         CALL nuage (paprs, play, &
1583              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1584              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1585              ok_aie, &              ok_aie, &
# Line 1641  contains Line 1603  contains
1603                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1604         ENDDO         ENDDO
1605         ! nouveau rayonnement (compatible Arpege-IFS):         ! nouveau rayonnement (compatible Arpege-IFS):
1606         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1607              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1608              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1609              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1610              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1611              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)  
1612         itaprad = 0         itaprad = 0
1613      ENDIF      ENDIF
1614      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1665  contains Line 1618  contains
1618      DO k = 1, llm      DO k = 1, llm
1619         DO i = 1, klon         DO i = 1, klon
1620            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1621                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.                 + (heat(i, k)-cool(i, k)) * dtphys/86400.
1622         ENDDO         ENDDO
1623      ENDDO      ENDDO
1624    
1625      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1626         ztit='after rad'         ztit='after rad'
1627         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1628              , 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, &
1629              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1630         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1631              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1632              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1633      END IF      END IF
1634    
1635      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
# Line 1705  contains Line 1656  contains
1656      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1657    
1658      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1659         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1660         igwd=0         igwd=0
1661         DO i=1, klon         DO i=1, klon
1662            itest(i)=0            itest(i)=0
# Line 1716  contains Line 1667  contains
1667            ENDIF            ENDIF
1668         ENDDO         ENDDO
1669    
1670         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, &
1671              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1672              igwd, idx, itest, &              igwd, idx, itest, &
1673              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
1674              zulow, zvlow, zustrdr, zvstrdr, &              zulow, zvlow, zustrdr, zvstrdr, &
1675              d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
1676    
1677         !  ajout des tendances         ! ajout des tendances
1678         DO k = 1, llm         DO k = 1, llm
1679            DO i = 1, klon            DO i = 1, klon
1680               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 1735  contains Line 1686  contains
1686    
1687      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1688    
1689         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1690         igwd=0         igwd=0
1691         DO i=1, klon         DO i=1, klon
1692            itest(i)=0            itest(i)=0
# Line 1746  contains Line 1697  contains
1697            ENDIF            ENDIF
1698         ENDDO         ENDDO
1699    
1700         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1701              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, &  
1702              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1703    
1704         !  ajout des tendances         ! ajout des tendances
1705         DO k = 1, llm         DO k = 1, llm
1706            DO i = 1, klon            DO i = 1, klon
1707               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 1772  contains Line 1720  contains
1720      ENDDO      ENDDO
1721      DO k = 1, llm      DO k = 1, llm
1722         DO i = 1, klon         DO i = 1, klon
1723            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)
1724            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)
1725         ENDDO         ENDDO
1726      ENDDO      ENDDO
1727    
1728      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1729    
1730      CALL aaam_bud(27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &
1731           ra, rg, romega, &           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &
          rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
1732           aam, torsfc)           aam, torsfc)
1733    
1734      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1735         ztit='after orography'         ztit='after orography'
1736         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1737              , 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, &
1738              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1739      END IF      END IF
1740    
1741      ! Calcul  des tendances traceurs      ! Calcul des tendances traceurs
1742      call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &
1743           nqmx-2, pdtphys, u, t, paprs, pplay, pmfu, pmfd, pen_u, pde_u, &           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &
1744           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1745           frac_impa, frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &
1746           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1747           tr_seri, zmasse)           tr_seri, zmasse)
1748    
1749      IF (offline) THEN      IF (offline) THEN
1750         call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1751              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1752              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1753      ENDIF      ENDIF
1754    
1755      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
# Line 1814  contains Line 1758  contains
1758    
1759      ! diag. bilKP      ! diag. bilKP
1760    
1761      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, &  
1762           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1763    
1764      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1827  contains Line 1770  contains
1770            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1771                 *(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)
1772            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)
1773            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k)/dtphys
1774         END DO         END DO
1775      END DO      END DO
1776      !-jld ec_conser      !-jld ec_conser
1777      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1778         ztit='after physic'         ztit='after physic'
1779         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1780              , 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, &
1781              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1782         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1783         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1784         !     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.
1785         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1786         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1787              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1788              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound )
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1789    
1790         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy=d_h_vcol
1791    
1792      END IF      END IF
1793    
1794      !   SORTIES      ! SORTIES
1795    
1796      !cc prw = eau precipitable      !cc prw = eau precipitable
1797      DO i = 1, klon      DO i = 1, klon
# Line 1864  contains Line 1805  contains
1805    
1806      DO k = 1, llm      DO k = 1, llm
1807         DO i = 1, klon         DO i = 1, klon
1808            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtphys
1809            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtphys
1810            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtphys
1811            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
1812            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
1813         ENDDO         ENDDO
1814      ENDDO      ENDDO
1815    
1816      IF (nqmx >= 3) THEN      IF (nqmx >= 3) THEN
1817         DO iq = 3, nqmx         DO iq = 3, nqmx
1818            DO  k = 1, llm            DO k = 1, llm
1819               DO  i = 1, klon               DO i = 1, klon
1820                  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
1821               ENDDO               ENDDO
1822            ENDDO            ENDDO
1823         ENDDO         ENDDO
# Line 1890  contains Line 1831  contains
1831         ENDDO         ENDDO
1832      ENDDO      ENDDO
1833    
1834      !   Ecriture des sorties      ! Ecriture des sorties
1835      call write_histhf      call write_histhf
1836      call write_histday      call write_histday
1837      call write_histins      call write_histins
# Line 1914  contains Line 1855  contains
1855      subroutine write_histday      subroutine write_histday
1856    
1857        use gr_phy_write_3d_m, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1858        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1859    
1860        !------------------------------------------------        !------------------------------------------------
1861    
# Line 1936  contains Line 1877  contains
1877    
1878      subroutine write_histhf      subroutine write_histhf
1879    
1880        ! 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
1881    
1882        !------------------------------------------------        !------------------------------------------------
1883    
# Line 1952  contains Line 1893  contains
1893    
1894      subroutine write_histins      subroutine write_histins
1895    
1896        ! 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
1897    
1898        real zout        real zout
1899        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1900    
1901        !--------------------------------------------------        !--------------------------------------------------
1902    
1903        IF (ok_instan) THEN        IF (ok_instan) THEN
1904           ! Champs 2D:           ! Champs 2D:
1905    
1906           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1907           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1908           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1909    
1910           i = NINT(zout/zsto)           i = NINT(zout/zsto)
# Line 2041  contains Line 1982  contains
1982           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1983    
1984           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
1985           !     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)
1986           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)
1987           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1988    
# Line 2166  contains Line 2107  contains
2107           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)
2108           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2109    
2110           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)
2111           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2112    
2113           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 2186  contains Line 2127  contains
2127    
2128      subroutine write_histhf3d      subroutine write_histhf3d
2129    
2130        ! 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
2131    
2132        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
2133    
2134        !-------------------------------------------------------        !-------------------------------------------------------
2135    
Legend:
Removed from v.46  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.21