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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC trunk/Sources/phylmd/physiq.f revision 226 by guez, Mon Oct 16 13:04:05 2017 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, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &         qx, omega, d_u, d_v, d_t, d_qx)
        d_t, d_qx, d_ps, dudyn, PVteta)  
   
     ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28  
   
     ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18  
   
     ! 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  
   
     use abort_gcm_m, only: abort_gcm  
     USE calendar, only: ymds2ju  
     use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &  
          cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &  
          ok_kzmin  
     use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &  
          cycle_diurne, new_oliq, soil_model  
     use comgeomphy  
     use conf_gcm_m, only: raz_date, offline  
     use conf_phys_m, only: conf_phys  
     use ctherm  
     use dimens_m, only: jjm, iim, llm  
     use dimphy, only: klon, nbtr  
     use dimsoil, only: nsoilmx  
     use hgardfou_m, only: hgardfou  
     USE histcom, only: histsync  
     USE histwrite_m, only: histwrite  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use ini_hist, only: ini_histhf, ini_histday, ini_histins  
     use iniprint, only: prt_level  
     use oasis_m  
     use orbite_m, only: orbite, zenang  
     use ozonecm_m, only: ozonecm  
     use phyetat0_m, only: phyetat0, rlat, rlon  
     use phyredem_m, only: phyredem  
     use phystokenc_m, only: phystokenc  
     use phytrac_m, only: phytrac  
     use qcheck_m, only: qcheck  
     use radepsi  
     use radopt  
     use temps, only: itau_phy, day_ref, annee_ref  
     use yoethf  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
   
     ! Declaration des constantes et des fonctions thermodynamiques :  
     use fcttre, only: thermcep, foeew, qsats, qsatl  
   
     ! Variables argument:  
   
     INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)  
   
     REAL, intent(in):: rdayvrai  
     ! (elapsed time since January 1st 0h of the starting year, in days)  
   
     REAL, intent(in):: gmtime ! heure de la journée en fraction de jour  
     REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)  
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
     logical, intent(in):: lafin ! dernier passage  
   
     REAL, intent(in):: paprs(klon, llm+1)  
     ! (pression pour chaque inter-couche, en Pa)  
9    
10      REAL, intent(in):: pplay(klon, llm)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (input pression pour le mileu de chaque couche (en Pa))      ! (subversion revision 678)
12    
13      REAL pphi(klon, llm)        ! Author: Z. X. Li (LMD/CNRS) 1993
     ! (input geopotentiel de chaque couche (g z) (reference sol))  
14    
15      REAL pphis(klon) ! input geopotentiel du sol      ! This is the main procedure for the "physics" part of the program.
16    
17        use aaam_bud_m, only: aaam_bud
18        USE abort_gcm_m, ONLY: abort_gcm
19        use ajsec_m, only: ajsec
20        use calltherm_m, only: calltherm
21        USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22             ok_instan
23        USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
24        USE clmain_m, ONLY: clmain
25        use clouds_gno_m, only: clouds_gno
26        use comconst, only: dtphys
27        USE comgeomphy, ONLY: airephy
28        USE concvl_m, ONLY: concvl
29        USE conf_gcm_m, ONLY: lmt_pas
30        USE conf_phys_m, ONLY: conf_phys
31        use conflx_m, only: conflx
32        USE ctherm, ONLY: iflag_thermals, nsplit_thermals
33        use diagcld2_m, only: diagcld2
34        USE dimens_m, ONLY: llm, nqmx
35        USE dimphy, ONLY: klon
36        USE dimsoil, ONLY: nsoilmx
37        use drag_noro_m, only: drag_noro
38        use dynetat0_m, only: day_ref, annee_ref
39        USE fcttre, ONLY: foeew
40        use fisrtilp_m, only: fisrtilp
41        USE hgardfou_m, ONLY: hgardfou
42        USE histsync_m, ONLY: histsync
43        USE histwrite_phy_m, ONLY: histwrite_phy
44        USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45             nbsrf
46        USE ini_histins_m, ONLY: ini_histins, nid_ins
47        use netcdf95, only: NF95_CLOSE
48        use newmicro_m, only: newmicro
49        use nr_util, only: assert
50        use nuage_m, only: nuage
51        USE orbite_m, ONLY: orbite
52        USE ozonecm_m, ONLY: ozonecm
53        USE phyetat0_m, ONLY: phyetat0, rlat, rlon
54        USE phyredem_m, ONLY: phyredem
55        USE phyredem0_m, ONLY: phyredem0
56        USE phytrac_m, ONLY: phytrac
57        use radlwsw_m, only: radlwsw
58        use yoegwd, only: sugwd
59        USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
60        use time_phylmdz, only: itap, increment_itap
61        use transp_m, only: transp
62        use transp_lay_m, only: transp_lay
63        use unit_nml_m, only: unit_nml
64        USE ymds2ju_m, ONLY: ymds2ju
65        USE yoethf_m, ONLY: r2es, rvtmp2
66        use zenang_m, only: zenang
67    
68      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      logical, intent(in):: lafin ! dernier passage
     REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s  
     REAL t(klon, llm)  ! input temperature (K)  
69    
70      REAL, intent(in):: qx(klon, llm, nq)      integer, intent(in):: dayvrai
71      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)      ! current day number, based at value 1 on January 1st of annee_ref
72    
73      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)  
     REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
     REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)  
     REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon)  ! output tendance physique de la pression au sol  
74    
75      INTEGER nbteta      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      PARAMETER(nbteta=3)      ! pression pour chaque inter-couche, en Pa
77    
78      REAL PVteta(klon, nbteta)      REAL, intent(in):: play(:, :) ! (klon, llm)
79      ! (output vorticite potentielle a des thetas constantes)      ! pression pour le mileu de chaque couche (en Pa)
80    
81      LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE      REAL, intent(in):: pphi(:, :) ! (klon, llm)
82      PARAMETER (ok_cvl=.TRUE.)      ! géopotentiel de chaque couche (référence sol)
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust=.FALSE.)  
83    
84      LOGICAL check ! Verifier la conservation du modele en eau      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
     PARAMETER (check=.FALSE.)  
     LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
     PARAMETER (ok_stratus=.FALSE.)  
85    
86      ! Parametres lies au coupleur OASIS:      REAL, intent(in):: u(:, :) ! (klon, llm)
87      INTEGER, SAVE :: npas, nexca      ! vitesse dans la direction X (de O a E) en m / s
     logical rnpb  
     parameter(rnpb=.true.)  
88    
89      character(len=6), save:: ocean      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
90      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
91    
92      logical ok_ocean      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
93      SAVE ok_ocean      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
94    
95      !IM "slab" ocean      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
96      REAL tslab(klon)    !Temperature du slab-ocean      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
97      SAVE tslab      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
98      REAL seaice(klon)   !glace de mer (kg/m2)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
     SAVE seaice  
     REAL fluxo(klon)    !flux turbulents ocean-glace de mer  
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
99    
100      ! Modele thermique du sol, a activer pour le cycle diurne:      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
101      logical, save:: ok_veget      ! tendance physique de "qx" (s-1)
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
102    
103      LOGICAL ok_mensuel ! sortir le fichier mensuel      ! Local:
104    
105      LOGICAL ok_instan ! sortir le fichier instantane      LOGICAL:: firstcal = .true.
     save ok_instan  
106    
107      LOGICAL ok_region ! sortir le fichier regional      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
108      PARAMETER (ok_region=.FALSE.)      ! Ajouter artificiellement les stratus
109    
110      !     pour phsystoke avec thermiques      ! pour phystoke avec thermiques
111      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
112      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
113      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
114      save q2  
115        INTEGER, PARAMETER:: ivap = 1 ! indice de traceur pour vapeur d'eau
116        INTEGER, PARAMETER:: iliq = 2 ! indice de traceur pour eau liquide
117    
118      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
119      PARAMETER (ivap=1)      LOGICAL, save:: ancien_ok
     INTEGER iliq          ! indice de traceurs pour eau liquide  
     PARAMETER (iliq=2)  
   
     REAL t_ancien(klon, llm), q_ancien(klon, llm)  
     SAVE t_ancien, q_ancien  
     LOGICAL ancien_ok  
     SAVE ancien_ok  
120    
121      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
122      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)
123    
124      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
125    
126      !IM Amip2 PV a theta constante      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
127        REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
128    
129      CHARACTER(LEN=3) ctetaSTD(nbteta)      REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
130      DATA ctetaSTD/'350', '380', '405'/      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL rtetaSTD(nbteta)  
     DATA rtetaSTD/350., 380., 405./  
   
     !MI Amip2 PV a theta constante  
   
     INTEGER klevp1  
     PARAMETER(klevp1=llm+1)  
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
     SAVE swdn0, swdn, swup0, swup  
   
     REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)  
     REAL lwup0(klon, klevp1), lwup(klon, klevp1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     !IM Amip2  
     ! variables a une pression donnee  
   
     integer nlevSTD  
     PARAMETER(nlevSTD=17)  
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN=4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70  ', '50  ', '30  ', '20  ', '10  '/  
131    
132      ! prw: precipitable water      ! prw: precipitable water
133      real prw(klon)      real prw(klon)
134    
135      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
136      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
137      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
138      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
139    
     INTEGER kmax, lmax  
     PARAMETER(kmax=8, lmax=8)  
     INTEGER kmaxm1, lmaxm1  
     PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)  
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN=4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN=3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     !IM ISCCP simulator v3.4  
   
     integer nid_hf, nid_hf3d  
     save nid_hf, nid_hf3d  
   
140      ! Variables propres a la physique      ! Variables propres a la physique
141    
142      INTEGER, save:: radpas      INTEGER, save:: radpas
143      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
144      ! "physiq".)      ! "physiq".
   
     REAL radsol(klon)  
     SAVE radsol               ! bilan radiatif au sol calcule par code radiatif  
   
     INTEGER, SAVE:: itap ! number of calls to "physiq"  
145    
146      REAL ftsol(klon, nbsrf)      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
147      SAVE ftsol                  ! temperature du sol      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
148    
149      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
150      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
151    
152      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap                 ! evaporation  
153      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
     SAVE fluxlat  
154    
155      REAL fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
156      SAVE fqsurf                 ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
157    
158      REAL qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
159      SAVE qsol                  ! hauteur d'eau dans le sol      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
160        REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
161    
162      REAL fsnow(klon, nbsrf)      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
     SAVE fsnow                  ! epaisseur neigeuse  
   
     REAL falbe(klon, nbsrf)  
     SAVE falbe                  ! albedo par type de surface  
     REAL falblw(klon, nbsrf)  
     SAVE falblw                 ! albedo par type de surface  
   
     ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :  
163      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
164      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
165      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 306  contains Line 168  contains
168      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
169      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
170      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
171      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
172        INTEGER igwd, itest(klon)
173    
174      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
175        REAL, save:: run_off_lic_0(klon)
176    
177      REAL agesno(klon, nbsrf)      ! Variables li\'ees \`a la convection d'Emanuel :
178      SAVE agesno                 ! age de la neige      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
179        REAL, save:: qcondc(klon, llm) ! in-cld water content from convect
180        REAL, save:: sig1(klon, llm), w01(klon, llm)
181    
182      REAL run_off_lic_0(klon)      ! Variables pour la couche limite (Alain Lahellec) :
183      SAVE run_off_lic_0      REAL cdragh(klon) ! drag coefficient pour T and Q
184      !KE43      REAL cdragm(klon) ! drag coefficient pour vent
     ! Variables liees a la convection de K. Emanuel (sb):  
185    
186      REAL bas, top             ! cloud base and top levels      ! Pour phytrac :
187      SAVE bas      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
188      SAVE top      REAL yu1(klon), yv1(klon) ! vent dans la premi\`ere couche
189    
190        REAL, save:: ffonte(klon, nbsrf)
191        ! flux thermique utilise pour fondre la neige
192    
193        REAL, save:: fqcalving(klon, nbsrf)
194        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
195        ! hauteur de neige, en kg / m2 / s
196    
197      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL zxffonte(klon), zxfqcalving(klon)
     SAVE Ma  
     REAL qcondc(klon, llm)    ! in-cld water content from convect  
     SAVE qcondc  
     REAL ema_work1(klon, llm), ema_work2(klon, llm)  
     SAVE ema_work1, ema_work2  
198    
199      REAL wd(klon) ! sb      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
200      SAVE wd       ! sb      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
201    
202      ! Variables locales pour la couche limite (al1):      REAL, save:: pfrac_1nucl(klon, llm)
203        ! Produits des coefs lessi nucl (alpha = 1)
204    
205      ! Variables locales:      REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
206        REAL frac_nucl(klon, llm) ! idem (nucleation)
207    
208      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL, save:: rain_fall(klon)
209      REAL cdragm(klon) ! drag coefficient pour vent      ! liquid water mass flux (kg / m2 / s), positive down
210    
211      !AA  Pour phytrac      REAL, save:: snow_fall(klon)
212      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      ! solid water mass flux (kg / m2 / s), positive down
     REAL yu1(klon)            ! vents dans la premiere couche U  
     REAL yv1(klon)            ! vents dans la premiere couche V  
     REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige  
     REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface  
     !                               !et necessaire pour limiter la  
     !                               !hauteur de neige, en kg/m2/s  
     REAL zxffonte(klon), zxfqcalving(klon)  
213    
     REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction  
     save pfrac_impa  
     REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
     save pfrac_nucl  
     REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)  
     save pfrac_1nucl  
     REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
     REAL frac_nucl(klon, llm) ! idem (nucleation)  
   
     !AA  
     REAL rain_fall(klon) ! pluie  
     REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
214      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
215    
216      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon) ! flux d'\'evaporation au sol
217      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
218      REAL dlw(klon)    ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
219      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
220        REAL, save:: dlw(klon) ! derivative of infra-red flux
221      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
222      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
     save fder  
223      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
224      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
225      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
226      REAL uq(klon) ! integr. verticale du transport zonal de l'eau      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
227    
228      REAL frugs(klon, nbsrf) ! longueur de rugosite      REAL, save:: frugs(klon, nbsrf) ! longueur de rugosite
     save frugs  
229      REAL zxrugs(klon) ! longueur de rugosite      REAL zxrugs(klon) ! longueur de rugosite
230    
231      ! Conditions aux limites      ! Conditions aux limites
232    
233      INTEGER julien      INTEGER julien
234        REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
235      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
     REAL pctsrf(klon, nbsrf)  
     !IM  
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
   
     SAVE pctsrf                 ! sous-fraction du sol  
     REAL albsol(klon)  
     SAVE albsol                 ! albedo du sol total  
     REAL albsollw(klon)  
     SAVE albsollw                 ! albedo du sol total  
   
236      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
237        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
238    
239      ! Declaration des procedures appelees      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
240        real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
     EXTERNAL alboc     ! calculer l'albedo sur ocean  
     EXTERNAL ajsec     ! ajustement sec  
     EXTERNAL clmain    ! couche limite  
     !KE43  
     EXTERNAL conema3  ! convect4.3  
     EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)  
     EXTERNAL nuage     ! calculer les proprietes radiatives  
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
     real clwcon(klon, llm), rnebcon(klon, llm)  
     real clwcon0(klon, llm), rnebcon0(klon, llm)  
   
     save rnebcon, clwcon  
   
     REAL rhcl(klon, llm)    ! humiditi relative ciel clair  
     REAL dialiq(klon, llm)  ! eau liquide nuageuse  
     REAL diafra(klon, llm)  ! fraction nuageuse  
     REAL cldliq(klon, llm)  ! eau liquide nuageuse  
     REAL cldfra(klon, llm)  ! fraction nuageuse  
     REAL cldtau(klon, llm)  ! epaisseur optique  
     REAL cldemi(klon, llm)  ! emissivite infrarouge  
   
     REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite  
     REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur  
     REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u  
     REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v  
   
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
   
     REAL heat(klon, llm)    ! chauffage solaire  
     REAL heat0(klon, llm)   ! chauffage solaire ciel clair  
     REAL cool(klon, llm)    ! refroidissement infrarouge  
     REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair  
     REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)  
     real sollwdown(klon)    ! downward LW flux at surface  
     REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)  
     REAL albpla(klon)  
     REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface  
     REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface  
     ! Le rayonnement n'est pas calcule tous les pas, il faut donc  
     !                      sauvegarder les sorties du rayonnement  
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
   
     REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)  
     REAL conv_t(klon, llm) ! convergence de la temperature(K/s)  
   
     REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut  
     REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree  
   
     REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)  
   
     REAL dist, rmu0(klon), fract(klon)  
     REAL zdtime ! pas de temps du rayonnement (s)  
     real zlongi  
241    
242        REAL rhcl(klon, llm) ! humiditi relative ciel clair
243        REAL dialiq(klon, llm) ! eau liquide nuageuse
244        REAL diafra(klon, llm) ! fraction nuageuse
245        REAL cldliq(klon, llm) ! eau liquide nuageuse
246        REAL cldfra(klon, llm) ! fraction nuageuse
247        REAL cldtau(klon, llm) ! epaisseur optique
248        REAL cldemi(klon, llm) ! emissivite infrarouge
249    
250        REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
251        REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
252        REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
253        REAL flux_v(klon, nbsrf) ! flux turbulent de vitesse v à la surface
254    
255        ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
256        ! les variables soient r\'emanentes.
257        REAL, save:: heat(klon, llm) ! chauffage solaire
258        REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
259        REAL, save:: cool(klon, llm) ! refroidissement infrarouge
260        REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
261        REAL, save:: topsw(klon), toplw(klon), solsw(klon)
262        REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
263        real, save:: sollwdown(klon) ! downward LW flux at surface
264        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
265        REAL, save:: albpla(klon)
266        REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
267        REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
268    
269        REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
270        REAL conv_t(klon, llm) ! convergence of temperature (K / s)
271    
272        REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
273        REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
274    
275        REAL zxfluxlat(klon)
276        REAL dist, mu0(klon), fract(klon)
277        real longi
278      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
279      LOGICAL zx_ajustq      REAL zb
280        REAL zx_t, zx_qs, zcor
     REAL za, zb  
     REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp  
281      real zqsat(klon, llm)      real zqsat(klon, llm)
282      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL t_coup  
     PARAMETER (t_coup=234.0)  
   
283      REAL zphi(klon, llm)      REAL zphi(klon, llm)
284    
285      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
286    
287      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
288      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
289      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
290      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
291      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
292      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
293      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
294      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
295      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
296      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
297      ! Grdeurs de sorties      ! Grandeurs de sorties
298      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
299      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
300      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
301      REAL s_trmb3(klon)      REAL s_trmb3(klon)
302    
303      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables pour la convection de K. Emanuel :
304    
305      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
306      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
307      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
308      REAL tvp(klon, llm)       ! virtual temp of lifted parcel  
309      REAL cape(klon)           ! CAPE      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
     SAVE cape  
   
     REAL pbase(klon)          ! cloud base pressure  
     SAVE pbase  
     REAL bbase(klon)          ! cloud base buoyancy  
     SAVE bbase  
     REAL rflag(klon)          ! flag fonctionnement de convect  
     INTEGER iflagctrl(klon)          ! flag fonctionnement de convect  
     ! -- convect43:  
     INTEGER ntra              ! nb traceurs pour convect4.3  
     REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)  
     REAL dplcldt(klon), dplcldr(klon)  
310    
311      ! Variables du changement      ! Variables du changement
312    
313      ! con: convection      ! con: convection
314      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
315      ! ajs: ajustement sec      ! ajs: ajustement sec
316      ! eva: evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
317      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
318      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
319      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
320      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
321      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
322      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
323      REAL rneb(klon, llm)      REAL rneb(klon, llm)
324    
325      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
326      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
327      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
328      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
329      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
330      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
   
     INTEGER ibas_con(klon), itop_con(klon)  
331    
332      SAVE ibas_con, itop_con      INTEGER, save:: ibas_con(klon), itop_con(klon)
333        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
334    
335      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
336      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
337      REAL d_ts(klon, nbsrf)      REAL, save:: snow_con(klon) ! neige (mm / s)
338        real snow_lsc(klon)
339        REAL d_ts(klon, nbsrf) ! variation of ftsol
340    
341      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
342      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 553  contains Line 346  contains
346      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
347      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
348    
349      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
350      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
351      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
352    
353      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
354      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
355      real, save:: facttemps      real:: facttemps = 1.e-4
356      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
357      real facteur      real facteur
358    
359      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
360      logical ptconv(klon, llm)      logical ptconv(klon, llm)
361    
362      ! Variables locales pour effectuer les appels en serie      ! Variables pour effectuer les appels en s\'erie :
363    
364      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
365      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm)
366      REAL u_seri(klon, llm), v_seri(klon, llm)      REAL u_seri(klon, llm), v_seri(klon, llm)
367        REAL tr_seri(klon, llm, nqmx - 2)
     REAL tr_seri(klon, llm, nbtr)  
     REAL d_tr(klon, llm, nbtr)  
368    
369      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
370    
# Line 585  contains Line 373  contains
373      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
374      REAL aam, torsfc      REAL aam, torsfc
375    
     REAL dudyn(iim+1, jjm + 1, llm)  
   
     REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique  
     REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)  
   
     INTEGER, SAVE:: nid_day, nid_ins  
   
376      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
377      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
378      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
379      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
380    
     REAL zsto  
   
     character(len=20) modname  
     character(len=80) abort_message  
     logical ok_sync  
381      real date0      real date0
382        REAL tsol(klon)
383    
384      !     Variables liees au bilan d'energie et d'enthalpi      REAL d_t_ec(klon, llm)
385      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
386      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      ! énergie thermique
     REAL      d_h_vcol_phy  
     REAL      fs_bound, fq_bound  
     SAVE      d_h_vcol_phy  
     REAL      zero_v(klon)  
     CHARACTER(LEN=15) ztit  
     INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.  
     SAVE      ip_ebil  
     DATA      ip_ebil/0/  
     INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics  
     !+jld ec_conser  
     REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique  
     REAL ZRCPD  
     !-jld ec_conser  
     !IM: t2m, q2m, u10m, v10m  
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m  
     REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille  
     !jq   Aerosol effects (Johannes Quaas, 27/11/2003)  
     REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]  
   
     REAL sulfate_pi(klon, llm)  
     ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))  
     SAVE sulfate_pi  
   
     REAL cldtaupi(klon, llm)  
     ! (Cloud optical thickness for pre-industrial (pi) aerosols)  
   
     REAL re(klon, llm)       ! Cloud droplet effective radius  
     REAL fl(klon, llm)  ! denominator of re  
   
     ! Aerosol optical properties  
     REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade=T -ADE=topswad-topsw  
   
     REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.  
     ! ok_aie=T ->  
     !        ok_ade=T -AIE=topswai-topswad  
     !        ok_ade=F -AIE=topswai-topsw  
   
     REAL aerindex(klon)       ! POLDER aerosol index  
   
     ! Parameters  
     LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not  
     REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)  
   
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
     SAVE u10m  
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
     SAVE rnebcon0  
     SAVE clwcon0  
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
387    
388      real zmasse(klon, llm)      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
389      ! (column-density of mass of air in a cell, in kg m-2)      ! temperature and humidity at 2 m
390    
391      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
392        ! composantes du vent \`a 10 m
393        
394        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
395        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
396    
397      !----------------------------------------------------------------      ! Aerosol effects:
398    
399      modname = 'physiq'      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
400      IF (if_ebil >= 1) THEN      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
        DO i=1, klon  
           zero_v(i)=0.  
        END DO  
     END IF  
     ok_sync=.TRUE.  
     IF (nq  <  2) THEN  
        abort_message = 'eaux vapeur et liquide sont indispensables'  
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
   
     test_firstcal: IF (firstcal) THEN  
        !  initialiser  
        u10m=0.  
        v10m=0.  
        t2m=0.  
        q2m=0.  
        ffonte=0.  
        fqcalving=0.  
        piz_ae(:, :, :)=0.  
        tau_ae(:, :, :)=0.  
        cg_ae(:, :, :)=0.  
        rain_con(:)=0.  
        snow_con(:)=0.  
        bl95_b0=0.  
        bl95_b1=0.  
        topswai(:)=0.  
        topswad(:)=0.  
        solswai(:)=0.  
        solswad(:)=0.  
   
        d_u_con = 0.0  
        d_v_con = 0.0  
        rnebcon0 = 0.0  
        clwcon0 = 0.0  
        rnebcon = 0.0  
        clwcon = 0.0  
   
        pblh   =0.        ! Hauteur de couche limite  
        plcl   =0.        ! Niveau de condensation de la CLA  
        capCL  =0.        ! CAPE de couche limite  
        oliqCL =0.        ! eau_liqu integree de couche limite  
        cteiCL =0.        ! cloud top instab. crit. couche limite  
        pblt   =0.        ! T a la Hauteur de couche limite  
        therm  =0.  
        trmb1  =0.        ! deep_cape  
        trmb2  =0.        ! inhibition  
        trmb3  =0.        ! Point Omega  
   
        IF (if_ebil >= 1) d_h_vcol_phy=0.  
   
        ! appel a la lecture du run.def physique  
   
        call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &  
             ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
   
        ! Initialiser les compteurs:  
401    
402         frugs = 0.      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
403         itap = 0      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
404         itaprad = 0      ! B). They link cloud droplet number concentration to aerosol mass
405         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &      ! concentration.
             seaice, fqsurf, qsol, fsnow, &  
             falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &  
             dlw, radsol, frugs, agesno, &  
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
   
        !   ATTENTION : il faudra a terme relire q2 dans l'etat initial  
        q2(:, :, :)=1.e-8  
   
        radpas = NINT( 86400. / pdtphys / nbapp_rad)  
406    
407         ! on remet le calendrier a zero      real zmasse(klon, llm)
408         IF (raz_date) itau_phy = 0      ! (column-density of mass of air in a cell, in kg m-2)
409    
410         PRINT *, 'cycle_diurne = ', cycle_diurne      integer, save:: ncid_startphy
411    
412         IF(ocean.NE.'force ') THEN      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
413            ok_ocean=.TRUE.           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1, iflag_thermals, &
414         ENDIF           nsplit_thermals
415    
416         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &      !----------------------------------------------------------------
             ok_region)  
417    
418         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
419            print *,'Nbre d appels au rayonnement insuffisant'           'eaux vapeur et liquide sont indispensables')
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        print *,"Clef pour la convection, iflag_con=", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
420    
421         ! Initialisation pour la convection de K.E. (sb):      test_firstcal: IF (firstcal) THEN
422         IF (iflag_con >= 3) THEN         ! initialiser
423           u10m_srf = 0.
424           v10m_srf = 0.
425           t2m = 0.
426           q2m = 0.
427           ffonte = 0.
428           fqcalving = 0.
429           rain_con = 0.
430           snow_con = 0.
431           d_u_con = 0.
432           d_v_con = 0.
433           rnebcon0 = 0.
434           clwcon0 = 0.
435           rnebcon = 0.
436           clwcon = 0.
437           pblh =0. ! Hauteur de couche limite
438           plcl =0. ! Niveau de condensation de la CLA
439           capCL =0. ! CAPE de couche limite
440           oliqCL =0. ! eau_liqu integree de couche limite
441           cteiCL =0. ! cloud top instab. crit. couche limite
442           pblt =0.
443           therm =0.
444           trmb1 =0. ! deep_cape
445           trmb2 =0. ! inhibition
446           trmb3 =0. ! Point Omega
447    
448           iflag_thermals = 0
449           nsplit_thermals = 1
450           print *, "Enter namelist 'physiq_nml'."
451           read(unit=*, nml=physiq_nml)
452           write(unit_nml, nml=physiq_nml)
453    
454            print *,"*** Convection de Kerry Emanuel 4.3  "         call conf_phys
455    
456            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG         ! Initialiser les compteurs:
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
457    
458           frugs = 0.
459           CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
460                fevap, rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
461                agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
462                q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
463                w01, ncid_startphy)
464    
465           ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
466           q2 = 1e-8
467    
468           radpas = lmt_pas / nbapp_rad
469           print *, "radpas = ", radpas
470    
471           ! Initialisation pour le sch\'ema de convection d'Emanuel :
472           IF (conv_emanuel) THEN
473              ibas_con = 1
474              itop_con = 1
475         ENDIF         ENDIF
476    
477         IF (ok_orodr) THEN         IF (ok_orodr) THEN
478            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
479            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(paprs, play)
480         else         else
481            rugoro = 0.            rugoro = 0.
482         ENDIF         ENDIF
483    
484         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         ecrit_ins = NINT(ecrit_ins / dtphys)
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
        ecrit_ins = NINT(ecrit_ins/pdtphys)  
        ecrit_hf = NINT(ecrit_hf/pdtphys)  
        ecrit_mth = NINT(ecrit_mth/pdtphys)  
        ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)  
        ecrit_reg = NINT(ecrit_reg/pdtphys)  
   
        ! Initialiser le couplage si necessaire  
   
        npas = 0  
        nexca = 0  
   
        print *,'AVANT HIST IFLAG_CON=', iflag_con  
   
        !   Initialisation des sorties  
   
        call ini_histhf(pdtphys, nid_hf, nid_hf3d)  
        call ini_histday(pdtphys, ok_journe, nid_day, nq)  
        call ini_histins(pdtphys, ok_instan, nid_ins)  
        CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)  
        !XXXPB Positionner date0 pour initialisation de ORCHIDEE  
        WRITE(*, *) 'physiq date0 : ', date0  
     ENDIF test_firstcal  
   
     ! Mettre a zero des variables de sortie (pour securite)  
   
     DO i = 1, klon  
        d_ps(i) = 0.0  
     ENDDO  
     DO k = 1, llm  
        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  
        DO k = 1, llm  
           DO i = 1, klon  
              d_qx(i, k, iq) = 0.0  
           ENDDO  
        ENDDO  
     ENDDO  
     da=0.  
     mp=0.  
     phi(:, :, :)=0.  
   
     ! Ne pas affecter les valeurs entrees de u, v, h, et q  
485    
486      DO k = 1, llm         ! Initialisation des sorties
        DO i = 1, klon  
           t_seri(i, k)  = t(i, k)  
           u_seri(i, k)  = u(i, k)  
           v_seri(i, k)  = v(i, k)  
           q_seri(i, k)  = qx(i, k, ivap)  
           ql_seri(i, k) = qx(i, k, iliq)  
           qs_seri(i, k) = 0.  
        ENDDO  
     ENDDO  
     IF (nq >= 3) THEN  
        tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)  
     ELSE  
        tr_seri(:, :, 1) = 0.  
     ENDIF  
487    
488      DO i = 1, klon         call ini_histins(dtphys, ok_newmicro)
489         ztsol(i) = 0.         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
490      ENDDO         ! Positionner date0 pour initialisation de ORCHIDEE
491      DO nsrf = 1, nbsrf         print *, 'physiq date0: ', date0
492         DO i = 1, klon         CALL phyredem0
493            ztsol(i) = ztsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)      ENDIF test_firstcal
        ENDDO  
     ENDDO  
494    
495      IF (if_ebil >= 1) THEN      ! We will modify variables *_seri and we will not touch variables
496         ztit='after dynamic'      ! u, v, t, qx:
497         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &      t_seri = t
498              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &      u_seri = u
499              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)      v_seri = v
500         !     Comme les tendances de la physique sont ajoute dans la dynamique,      q_seri = qx(:, :, ivap)
501         !     on devrait avoir que la variation d'entalpie par la dynamique      ql_seri = qx(:, :, iliq)
502         !     est egale a la variation de la physique au pas de temps precedent.      tr_seri = qx(:, :, 3:nqmx)
        !     Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, ztit, ip_ebil &  
             , zero_v, zero_v, zero_v, zero_v, zero_v &  
             , zero_v, zero_v, zero_v, ztsol &  
             , d_h_vcol+d_h_vcol_phy, d_qt, 0. &  
             , fs_bound, fq_bound )  
     END IF  
503    
504      ! Diagnostiquer la tendance dynamique      tsol = sum(ftsol * pctsrf, dim = 2)
505    
506        ! Diagnostic de la tendance dynamique :
507      IF (ancien_ok) THEN      IF (ancien_ok) THEN
508         DO k = 1, llm         DO k = 1, llm
509            DO i = 1, klon            DO i = 1, klon
510               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
511               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
512            ENDDO            ENDDO
513         ENDDO         ENDDO
514      ELSE      ELSE
515         DO k = 1, llm         DO k = 1, llm
516            DO i = 1, klon            DO i = 1, klon
517               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
518               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
519            ENDDO            ENDDO
520         ENDDO         ENDDO
521         ancien_ok = .TRUE.         ancien_ok = .TRUE.
522      ENDIF      ENDIF
523    
524      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
525      DO k = 1, llm      DO k = 1, llm
526         DO i = 1, klon         DO i = 1, klon
527            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
528         ENDDO         ENDDO
529      ENDDO      ENDDO
530    
531      ! Verifier les temperatures      ! Check temperatures:
   
532      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
533    
534      ! Incrementer le compteur de la physique      call increment_itap
535        julien = MOD(dayvrai, 360)
     itap = itap + 1  
     julien = MOD(NINT(rdayvrai), 360)  
536      if (julien == 0) julien = 360      if (julien == 0) julien = 360
537    
538      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
   
     ! Mettre en action les conditions aux limites (albedo, sst, etc.).  
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
   
     if (nq >= 5) then  
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
539    
540      ! Re-evaporer l'eau liquide nuageuse      ! \'Evaporation de l'eau liquide nuageuse :
541        DO k = 1, llm
     DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse  
542         DO i = 1, klon         DO i = 1, klon
543            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
544            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
545            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
546            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
547         ENDDO         ENDDO
548      ENDDO      ENDDO
549        ql_seri = 0.
550    
551      IF (if_ebil >= 2) THEN      frugs = MAX(frugs, 0.000015)
552         ztit='after reevap'      zxrugs = sum(frugs * pctsrf, dim = 2)
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        call diagphy(airephy, ztit, ip_ebil &  
             , zero_v, zero_v, zero_v, zero_v, zero_v &  
             , zero_v, zero_v, zero_v, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
553    
554      END IF      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
555        ! la surface.
556    
557      ! Appeler la diffusion verticale (programme de couche limite)      CALL orbite(REAL(julien), longi, dist)
558        CALL zenang(longi, time, dtphys * radpas, mu0, fract)
559        albsol = sum(falbe * pctsrf, dim = 2)
560    
561        ! R\'epartition sous maille des flux longwave et shortwave
562        ! R\'epartition du longwave par sous-surface lin\'earis\'ee
563    
564        forall (nsrf = 1: nbsrf)
565           fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
566                * (tsol - ftsol(:, nsrf))
567           fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
568        END forall
569    
570        CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
571             ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
572             paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
573             snow_fall, fsolsw, fsollw, frugs, agesno, rugoro, d_t_vdf, d_q_vdf, &
574             d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, &
575             cdragm, q2, dsens, devap, ycoefh, t2m, q2m, u10m_srf, v10m_srf, &
576             pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
577             fqcalving, ffonte, run_off_lic_0)
578    
579        ! Incr\'ementation des flux
580    
581        sens = - sum(flux_t * pctsrf, dim = 2)
582        evap = - sum(flux_q * pctsrf, dim = 2)
583        fder = dlw + dsens + devap
584    
585      DO i = 1, klon      yu1 = u_seri(:, 1)
586         zxrugs(i) = 0.0      yv1 = v_seri(:, 1)
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           frugs(i, nsrf) = MAX(frugs(i, nsrf), 0.000015)  
        ENDDO  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxrugs(i) = zxrugs(i) + frugs(i, nsrf)*pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     ! calculs necessaires au calcul de l'albedo dans l'interface  
   
     CALL orbite(REAL(julien), zlongi, dist)  
     IF (cycle_diurne) THEN  
        zdtime = pdtphys * REAL(radpas)  
        CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)  
     ELSE  
        rmu0 = -999.999  
     ENDIF  
   
     !     Calcul de l'abedo moyen par maille  
     albsol(:)=0.  
     albsollw(:)=0.  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)  
           albsollw(i) = albsollw(i) + falblw(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
   
     !     Repartition sous maille des flux LW et SW  
     ! Repartition du longwave par sous-surface linearisee  
   
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           fsollw(i, nsrf) = sollw(i) &  
                + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))  
           fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))  
        ENDDO  
     ENDDO  
   
     fder = dlw  
   
     CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &  
          t_seri, q_seri, u_seri, v_seri, &  
          julien, rmu0, co2_ppm,  &  
          ok_veget, ocean, npas, nexca, ftsol, &  
          soil_model, cdmmax, cdhmax, &  
          ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &  
          paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &  
          fluxlat, rain_fall, snow_fall, &  
          fsolsw, fsollw, sollwdown, fder, &  
          rlon, rlat, cuphy, cvphy, frugs, &  
          firstcal, lafin, agesno, rugoro, &  
          d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &  
          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)  
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) +  &  
                   fluxt(i, k, nsrf) * pctsrf( i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) +  &  
                   fluxq(i, k, nsrf) * pctsrf( i, nsrf)  
              zxfluxu(i, k) = zxfluxu(i, k) +  &  
                   fluxu(i, k, nsrf) * pctsrf( i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) +  &  
                   fluxv(i, k, nsrf) * pctsrf( i, nsrf)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
587    
588      DO k = 1, llm      DO k = 1, llm
589         DO i = 1, klon         DO i = 1, klon
# Line 1089  contains Line 594  contains
594         ENDDO         ENDDO
595      ENDDO      ENDDO
596    
597      IF (if_ebil >= 2) THEN      ! Update surface temperature:
        ztit='after clmain'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        call diagphy(airephy, ztit, ip_ebil &  
             , zero_v, zero_v, zero_v, zero_v, sens &  
             , evap, zero_v, zero_v, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
     END IF  
   
     ! Incrementer la temperature du sol  
   
     DO i = 1, klon  
        zxtsol(i) = 0.0  
        zxfluxlat(i) = 0.0  
   
        zt2m(i) = 0.0  
        zq2m(i) = 0.0  
        zu10m(i) = 0.0  
        zv10m(i) = 0.0  
        zxffonte(i) = 0.0  
        zxfqcalving(i) = 0.0  
   
        s_pblh(i) = 0.0  
        s_lcl(i) = 0.0  
        s_capCL(i) = 0.0  
        s_oliqCL(i) = 0.0  
        s_cteiCL(i) = 0.0  
        s_pblT(i) = 0.0  
        s_therm(i) = 0.0  
        s_trmb1(i) = 0.0  
        s_trmb2(i) = 0.0  
        s_trmb3(i) = 0.0  
   
        IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &  
             pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &  
             THEN  
           WRITE(*, *) 'physiq : pb sous surface au point ', i,  &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)  
           zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)  
           zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)  
   
           zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)  
           zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)  
           zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)  
           zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)  
           zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)  
           zxfqcalving(i) = zxfqcalving(i) +  &  
                fqcalving(i, nsrf)*pctsrf(i, nsrf)  
           s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)  
           s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)  
           s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)  
           s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)  
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
598    
599      ! Si une sous-fraction n'existe pas, elle prend la temp. moyenne      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
600        ftsol = ftsol + d_ts
601        tsol = sum(ftsol * pctsrf, dim = 2)
602        zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
603        zt2m = sum(t2m * pctsrf, dim = 2)
604        zq2m = sum(q2m * pctsrf, dim = 2)
605        u10m = sum(u10m_srf * pctsrf, dim = 2)
606        v10m = sum(v10m_srf * pctsrf, dim = 2)
607        zxffonte = sum(ffonte * pctsrf, dim = 2)
608        zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
609        s_pblh = sum(pblh * pctsrf, dim = 2)
610        s_lcl = sum(plcl * pctsrf, dim = 2)
611        s_capCL = sum(capCL * pctsrf, dim = 2)
612        s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
613        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
614        s_pblT = sum(pblT * pctsrf, dim = 2)
615        s_therm = sum(therm * pctsrf, dim = 2)
616        s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
617        s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
618        s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
619    
620        ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
621      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
622         DO i = 1, klon         DO i = 1, klon
623            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
624                 ftsol(i, nsrf) = tsol(i)
625            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
626            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
627            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)               u10m_srf(i, nsrf) = u10m(i)
628            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)               v10m_srf(i, nsrf) = v10m(i)
629            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
630            IF (pctsrf(i, nsrf)  <  epsfra)  &               fqcalving(i, nsrf) = zxfqcalving(i)
631                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
632            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
633            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
634            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
635            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
636            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
637            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)               therm(i, nsrf) = s_therm(i)
638            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
639            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
640            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
641            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            end IF
642         ENDDO         ENDDO
643      ENDDO      ENDDO
644    
645      ! Calculer la derive du flux infrarouge      dlw = - 4. * RSIGMA * tsol**3
646    
647      DO i = 1, klon      ! Appeler la convection
648         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3  
649      ENDDO      if (conv_emanuel) then
650           CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
651      ! Appeler la convection (au choix)              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
652                upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
653      DO k = 1, llm         snow_con = 0.
654         DO i = 1, klon         clwcon0 = qcondc
655            conv_q(i, k) = d_q_dyn(i, k)  &         mfu = upwd + dnwd
656                 + d_q_vdf(i, k)/pdtphys  
657            conv_t(i, k) = d_t_dyn(i, k)  &         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
658                 + d_t_vdf(i, k)/pdtphys         zqsat = zqsat / (1. - retv * zqsat)
659         ENDDO  
660      ENDDO         ! Properties of convective clouds
661      IF (check) THEN         clwcon0 = fact_cldcon * clwcon0
662         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
663         print *, "avantcon=", za              rnebcon0)
664      ENDIF  
665      zx_ajustq = .FALSE.         forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
666      IF (iflag_con == 2) zx_ajustq=.TRUE.         mfd = 0.
667      IF (zx_ajustq) THEN         pen_u = 0.
668         DO i = 1, klon         pen_d = 0.
669            z_avant(i) = 0.0         pde_d = 0.
670         ENDDO         pde_u = 0.
671         DO k = 1, llm      else
672            DO i = 1, klon         conv_q = d_q_dyn + d_q_vdf / dtphys
673               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &         conv_t = d_t_dyn + d_t_vdf / dtphys
674                    *zmasse(i, k)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
675            ENDDO         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
676         ENDDO              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
677      ENDIF              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
678      IF (iflag_con == 1) THEN              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
679         stop 'reactiver le call conlmd dans physiq.F'              kdtop, pmflxr, pmflxs)
     ELSE IF (iflag_con == 2) THEN  
        CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &  
             conv_t, conv_q, zxfluxq(1, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, &  
             pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
680         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
681         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
682         DO i = 1, klon         ibas_con = llm + 1 - kcbot
683            ibas_con(i) = llm+1 - kcbot(i)         itop_con = llm + 1 - kctop
684            itop_con(i) = llm+1 - kctop(i)      END if
        ENDDO  
     ELSE IF (iflag_con >= 3) THEN  
        ! nb of tracers for the KE convection:  
        ! MAF la partie traceurs est faite dans phytrac  
        ! on met ntra=1 pour limiter les appels mais on peut  
        ! supprimer les calculs / ftra.  
        ntra = 1  
        ! Schema de convection modularise et vectorise:  
        ! (driver commun aux versions 3 et 4)  
   
        IF (ok_cvl) THEN ! new driver for convectL  
           CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, &  
                Ma, cape, tvp, iflagctrl, &  
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
   
           clwcon0=qcondc  
           pmfu=upwd+dnwd  
        ELSE ! ok_cvl  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
   
        IF (.NOT. ok_gust) THEN  
           do i = 1, klon  
              wd(i)=0.0  
           enddo  
        ENDIF  
   
        ! Calcul des proprietes des nuages convectifs  
   
        DO k = 1, llm  
           DO i = 1, klon  
              zx_t = t_seri(i, k)  
              IF (thermcep) THEN  
                 zdelta = MAX(0., SIGN(1., rtt-zx_t))  
                 zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)  
                 zx_qs  = MIN(0.5, zx_qs)  
                 zcor   = 1./(1.-retv*zx_qs)  
                 zx_qs  = zx_qs*zcor  
              ELSE  
                 IF (zx_t < t_coup) THEN  
                    zx_qs = qsats(zx_t)/pplay(i, k)  
                 ELSE  
                    zx_qs = qsatl(zx_t)/pplay(i, k)  
                 ENDIF  
              ENDIF  
              zqsat(i, k)=zx_qs  
           ENDDO  
        ENDDO  
   
        !   calcul des proprietes des nuages convectifs  
        clwcon0=fact_cldcon*clwcon0  
        call clouds_gno &  
             (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)  
     ELSE  
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     ENDIF  
685    
686      DO k = 1, llm      DO k = 1, llm
687         DO i = 1, klon         DO i = 1, klon
# Line 1314  contains Line 692  contains
692         ENDDO         ENDDO
693      ENDDO      ENDDO
694    
695      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
696         ztit='after convect'         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
697         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        call diagphy(airephy, ztit, ip_ebil &  
             , zero_v, zero_v, zero_v, zero_v, zero_v &  
             , zero_v, rain_con, snow_con, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
     END IF  
   
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *,"aprescon=", za  
        zx_t = 0.0  
        za = 0.0  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*pdtphys  
        print *,"Precip=", zx_t  
     ENDIF  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_apres(i) = 0.0  
        ENDDO  
698         DO k = 1, llm         DO k = 1, llm
699            DO i = 1, klon            DO i = 1, klon
700               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &  
                /z_apres(i)  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &  
                   z_factor(i) < (1.0-1.0E-08)) THEN  
701                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
702               ENDIF               ENDIF
703            ENDDO            ENDDO
704         ENDDO         ENDDO
705      ENDIF      ENDIF
     zx_ajustq=.FALSE.  
706    
707      ! Convection seche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
708    
709      d_t_ajs=0.      d_t_ajs = 0.
710      d_u_ajs=0.      d_u_ajs = 0.
711      d_v_ajs=0.      d_v_ajs = 0.
712      d_q_ajs=0.      d_q_ajs = 0.
713      fm_therm=0.      fm_therm = 0.
714      entr_therm=0.      entr_therm = 0.
715    
716      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
717           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
718           , 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)  
719         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
720         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
721      else      else
722         !  Thermiques         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
723         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
             , iflag_thermals, '   nsplit_thermals=', nsplit_thermals  
        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)  
724      endif      endif
725    
726      IF (if_ebil >= 2) THEN      ! Caclul des ratqs
        ztit='after dry_adjust'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     !  Caclul des ratqs  
727    
728      !   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
729      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
730      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
731         do k=1, llm         do k = 1, llm
732            do i=1, klon            do i = 1, klon
733               if(ptconv(i, k)) then               if(ptconv(i, k)) then
734                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
735                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
736               else               else
737                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
738               endif               endif
739            enddo            enddo
740         enddo         enddo
741      endif      endif
742    
743      !   ratqs stables      ! ratqs stables
744      do k=1, llm      do k = 1, llm
745         do i=1, klon         do i = 1, klon
746            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
747                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
748         enddo         enddo
749      enddo      enddo
750    
751      !  ratqs final      ! ratqs final
752      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
753         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
754         !   ratqs final         ! ratqs final
755         !   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
756         !   relaxation des ratqs         ! relaxation des ratqs
757         facteur=exp(-pdtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
758         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs, ratqsc)
        ratqs=max(ratqs, ratqsc)  
759      else      else
760         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
761         ratqs=ratqss         ratqs = ratqss
762      endif      endif
763    
764      ! Appeler le processus de condensation a grande echelle      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
765      ! et le processus de precipitation           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
766      CALL fisrtilp(pdtphys, paprs, pplay, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
767           t_seri, q_seri, ptconv, ratqs, &           psfl, rhcl)
          d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &  
          rain_lsc, snow_lsc, &  
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
768    
769      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
770      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1463  contains Line 777  contains
777            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
778         ENDDO         ENDDO
779      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)  
        print *,"apresilp=", za  
        zx_t = 0.0  
        za = 0.0  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*pdtphys  
        print *,"Precip=", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        ztit='after fisrt'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        call diagphy(airephy, ztit, ip_ebil &  
             , zero_v, zero_v, zero_v, zero_v, zero_v &  
             , zero_v, rain_lsc, snow_lsc, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
     END IF  
780    
781      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
782    
783      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
784    
785      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= - 1) THEN
786         snow_tiedtke=0.         ! seulement pour Tiedtke
787         if (iflag_cldcon == -1) then         snow_tiedtke = 0.
788            rain_tiedtke=rain_con         if (iflag_cldcon == - 1) then
789              rain_tiedtke = rain_con
790         else         else
791            rain_tiedtke=0.            rain_tiedtke = 0.
792            do k=1, llm            do k = 1, llm
793               do i=1, klon               do i = 1, klon
794                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
795                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
796                          *zmasse(i, k)                          * zmasse(i, k)
797                  endif                  endif
798               enddo               enddo
799            enddo            enddo
800         endif         endif
801    
802         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
803         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
804              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
805         DO k = 1, llm         DO k = 1, llm
806            DO i = 1, klon            DO i = 1, klon
807               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
808                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
809                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
810               ENDIF               ENDIF
811            ENDDO            ENDDO
812         ENDDO         ENDDO
   
813      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
814         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
815         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps pr\'ec\'edent diminu\'e
816         ! facttemps         ! d'un facteur facttemps.
817         facteur = pdtphys *facttemps         facteur = dtphys * facttemps
818         do k=1, llm         do k = 1, llm
819            do i=1, klon            do i = 1, klon
820               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
821               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
822                    then                    > rnebcon(i, k) * clwcon(i, k)) then
823                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
824                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
825               endif               endif
826            enddo            enddo
827         enddo         enddo
828    
829         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
830         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
831         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
   
832      ENDIF      ENDIF
833    
834      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
835    
836      IF (ok_stratus) THEN      IF (ok_stratus) THEN
837         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
838         DO k = 1, llm         DO k = 1, llm
839            DO i = 1, klon            DO i = 1, klon
840               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
841                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
842                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
843               ENDIF               ENDIF
# Line 1559  contains Line 846  contains
846      ENDIF      ENDIF
847    
848      ! Precipitation totale      ! Precipitation totale
   
849      DO i = 1, klon      DO i = 1, klon
850         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
851         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
852      ENDDO      ENDDO
853    
854      IF (if_ebil >= 2) THEN      ! Humidit\'e relative pour diagnostic :
        ztit="after diagcld"  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
   
855      DO k = 1, llm      DO k = 1, llm
856         DO i = 1, klon         DO i = 1, klon
857            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
858            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
859               zdelta = MAX(0., SIGN(1., rtt-zx_t))            zx_qs = MIN(0.5, zx_qs)
860               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)            zcor = 1. / (1. - retv * zx_qs)
861               zx_qs  = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
862               zcor   = 1./(1.-retv*zx_qs)            zx_rh(i, k) = q_seri(i, k) / zx_qs
863               zx_qs  = zx_qs*zcor            zqsat(i, k) = zx_qs
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/pplay(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/pplay(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
           zqsat(i, k)=zx_qs  
864         ENDDO         ENDDO
865      ENDDO      ENDDO
     !jq - introduce the aerosol direct and first indirect radiative forcings  
     !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)  
     IF (ok_ade.OR.ok_aie) THEN  
        ! Get sulfate aerosol distribution  
        CALL readsulfate(rdayvrai, firstcal, sulfate)  
        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)  
   
        ! Calculate aerosol optical properties (Olivier Boucher)  
        CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &  
             tau_ae, piz_ae, cg_ae, aerindex)  
     ELSE  
        tau_ae(:, :, :)=0.0  
        piz_ae(:, :, :)=0.0  
        cg_ae(:, :, :)=0.0  
     ENDIF  
   
     ! Calculer les parametres optiques des nuages et quelques  
     ! parametres pour diagnostiques:  
866    
867        ! Param\`etres optiques des nuages et quelques param\`etres pour
868        ! diagnostics :
869      if (ok_newmicro) then      if (ok_newmicro) then
870         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
871              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             cldh, cldl, cldm, cldt, cldq, &  
             flwp, fiwp, flwc, fiwc, &  
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
872      else      else
873         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
874              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq)
             cldh, cldl, cldm, cldt, cldq, &  
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
875      endif      endif
876    
877      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
878           wo = ozonecm(REAL(julien), paprs)
879      IF (MOD(itaprad, radpas) == 0) THEN         albsol = sum(falbe * pctsrf, dim = 2)
880         DO i = 1, klon         CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
881            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
882                 + falbe(i, is_lic) * pctsrf(i, is_lic) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
883                 + falbe(i, is_ter) * pctsrf(i, is_ter) &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
884                 + falbe(i, is_sic) * pctsrf(i, is_sic)              swup0, swup, ok_ade, topswad, solswad)
           albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &  
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
        ! nouveau rayonnement (compatible Arpege-IFS):  
        CALL radlwsw(dist, rmu0, fract,  &  
             paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &  
             wo, &  
             cldfra, cldemi, cldtau, &  
             heat, heat0, cool, cool0, radsol, albpla, &  
             topsw, toplw, solsw, sollw, &  
             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)  
        itaprad = 0  
885      ENDIF      ENDIF
     itaprad = itaprad + 1  
886    
887      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
888      DO k = 1, llm      DO k = 1, llm
889         DO i = 1, klon         DO i = 1, klon
890            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
891                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.                 / 86400.
        ENDDO  
     ENDDO  
   
     IF (if_ebil >= 2) THEN  
        ztit='after rad'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        call diagphy(airephy, ztit, ip_ebil &  
             , topsw, toplw, solsw, sollw, zero_v &  
             , zero_v, zero_v, zero_v, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
     END IF  
   
     ! Calculer l'hydrologie de la surface  
   
     DO i = 1, klon  
        zxqsurf(i) = 0.0  
        zxsnow(i) = 0.0  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)  
892         ENDDO         ENDDO
893      ENDDO      ENDDO
894    
895      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
   
896      DO i = 1, klon      DO i = 1, klon
897         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
898      ENDDO      ENDDO
899    
900      !mod deb lott(jan95)      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
901    
902      IF (ok_orodr) THEN      IF (ok_orodr) THEN
903         !  selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
904         igwd=0         igwd = 0
905         DO i=1, klon         DO i = 1, klon
906            itest(i)=0            itest(i) = 0
907            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
908               itest(i)=1               itest(i) = 1
909               igwd=igwd+1               igwd = igwd + 1
              idx(igwd)=i  
910            ENDIF            ENDIF
911         ENDDO         ENDDO
912    
913         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
914              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
915              igwd, idx, itest, &              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
916    
917         !  ajout des tendances         ! ajout des tendances
918         DO k = 1, llm         DO k = 1, llm
919            DO i = 1, klon            DO i = 1, klon
920               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 1740  contains Line 925  contains
925      ENDIF      ENDIF
926    
927      IF (ok_orolf) THEN      IF (ok_orolf) THEN
928           ! S\'election des points pour lesquels le sch\'ema est actif :
929         !  selection des points pour lesquels le shema est actif:         igwd = 0
930         igwd=0         DO i = 1, klon
931         DO i=1, klon            itest(i) = 0
932            itest(i)=0            IF (zpic(i) - zmea(i) > 100.) THEN
933            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
934               itest(i)=1               igwd = igwd + 1
              igwd=igwd+1  
              idx(igwd)=i  
935            ENDIF            ENDIF
936         ENDDO         ENDDO
937    
938         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
939              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, &  
940              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
941    
942         !  ajout des tendances         ! Ajout des tendances :
943         DO k = 1, llm         DO k = 1, llm
944            DO i = 1, klon            DO i = 1, klon
945               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 1767  contains Line 947  contains
947               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)
948            ENDDO            ENDDO
949         ENDDO         ENDDO
950        ENDIF
951    
952      ENDIF ! fin de test sur ok_orolf      ! Stress n\'ecessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
953    
954      DO i = 1, klon      DO i = 1, klon
955         zustrph(i)=0.         zustrph(i) = 0.
956         zvstrph(i)=0.         zvstrph(i) = 0.
957      ENDDO      ENDDO
958      DO k = 1, llm      DO k = 1, llm
959         DO i = 1, klon         DO i = 1, klon
960            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 &
961            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)                 * zmasse(i, k)
962              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
963                   * zmasse(i, k)
964         ENDDO         ENDDO
965      ENDDO      ENDDO
966    
967      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
968             zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
969    
970      CALL aaam_bud(27, klon, llm, gmtime, &      ! Calcul des tendances traceurs
971           ra, rg, romega, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
972           rlat, rlon, pphis, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
973           zustrdr, zustrli, zustrph, &           pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, tr_seri, &
974           zvstrdr, zvstrli, zvstrph, &           zmasse, ncid_startphy)
          paprs, u, v, &  
          aam, torsfc)  
   
     IF (if_ebil >= 2) THEN  
        ztit='after orography'  
        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calcul  des tendances traceurs  
     call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &  
          pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &  
          pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &  
          frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &  
          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &  
          psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
   
     IF (offline) THEN  
        call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &  
             pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
             pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)  
     ENDIF  
975    
976      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
977      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
978    
979      ! diag. bilKP      ! diag. bilKP
980    
981      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
          t_seri, q_seri, u_seri, v_seri, zphi, &  
982           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
983    
984      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
985    
986      !+jld ec_conser      ! conversion Ec en énergie thermique
987      DO k = 1, llm      DO k = 1, llm
988         DO i = 1, klon         DO i = 1, klon
989            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
990            d_t_ec(i, k)=0.5/ZRCPD &                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
991                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
992            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
           d_t_ec(i, k) = d_t_ec(i, k)/pdtphys  
993         END DO         END DO
994      END DO      END DO
     !-jld ec_conser  
     IF (if_ebil >= 1) THEN  
        ztit='after physic'  
        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &  
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
        !     Comme les tendances de la physique sont ajoute dans la dynamique,  
        !     on devrait avoir que la variation d'entalpie par la dynamique  
        !     est egale a la variation de la physique au pas de temps precedent.  
        !     Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, ztit, ip_ebil &  
             , topsw, toplw, solsw, sollw, sens &  
             , evap, rain_fall, snow_fall, ztsol &  
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
   
        d_h_vcol_phy=d_h_vcol  
   
     END IF  
995    
996      !   SORTIES      ! SORTIES
997    
998      !cc prw = eau precipitable      ! prw = eau precipitable
999      DO i = 1, klon      DO i = 1, klon
1000         prw(i) = 0.         prw(i) = 0.
1001         DO k = 1, llm         DO k = 1, llm
1002            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
1003         ENDDO         ENDDO
1004      ENDDO      ENDDO
1005    
# Line 1870  contains Line 1007  contains
1007    
1008      DO k = 1, llm      DO k = 1, llm
1009         DO i = 1, klon         DO i = 1, klon
1010            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1011            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1012            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1013            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
1014            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
1015         ENDDO         ENDDO
1016      ENDDO      ENDDO
1017    
1018      IF (nq >= 3) THEN      DO iq = 3, nqmx
1019         DO iq = 3, nq         DO k = 1, llm
1020            DO  k = 1, llm            DO i = 1, klon
1021               DO  i = 1, klon               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
                 d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys  
              ENDDO  
1022            ENDDO            ENDDO
1023         ENDDO         ENDDO
1024      ENDIF      ENDDO
1025    
1026      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
1027      DO k = 1, llm      DO k = 1, llm
# Line 1896  contains Line 1031  contains
1031         ENDDO         ENDDO
1032      ENDDO      ENDDO
1033    
1034      !   Ecriture des sorties      CALL histwrite_phy("phis", pphis)
1035      call write_histhf      CALL histwrite_phy("aire", airephy)
1036      call write_histday      CALL histwrite_phy("psol", paprs(:, 1))
1037      call write_histins      CALL histwrite_phy("precip", rain_fall + snow_fall)
1038        CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1039      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("pluc", rain_con + snow_con)
1040      IF (lafin) THEN      CALL histwrite_phy("tsol", tsol)
1041         itau_phy = itau_phy + itap      CALL histwrite_phy("t2m", zt2m)
1042         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &      CALL histwrite_phy("q2m", zq2m)
1043              ftsoil, tslab, seaice, fqsurf, qsol, &      CALL histwrite_phy("u10m", u10m)
1044              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &      CALL histwrite_phy("v10m", v10m)
1045              solsw, sollwdown, dlw, &      CALL histwrite_phy("snow", snow_fall)
1046              radsol, frugs, agesno, &      CALL histwrite_phy("cdrm", cdragm)
1047              zmea, zstd, zsig, zgam, zthe, zpic, zval, &      CALL histwrite_phy("cdrh", cdragh)
1048              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)      CALL histwrite_phy("topl", toplw)
1049      ENDIF      CALL histwrite_phy("evap", evap)
1050        CALL histwrite_phy("sols", solsw)
1051    contains      CALL histwrite_phy("soll", sollw)
1052        CALL histwrite_phy("solldown", sollwdown)
1053      subroutine write_histday      CALL histwrite_phy("bils", bils)
1054        CALL histwrite_phy("sens", - sens)
1055        use gr_phy_write_3d_m, only: gr_phy_write_3d      CALL histwrite_phy("fder", fder)
1056        integer itau_w  ! pas de temps ecriture      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
1057        CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
1058        !------------------------------------------------      CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
1059        CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
       if (ok_journe) THEN  
          itau_w = itau_phy + itap  
          if (nq <= 4) then  
             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &  
                  gr_phy_write_3d(wo) * 1e3)  
             ! (convert "wo" from kDU to DU)  
          end if  
          if (ok_sync) then  
             call histsync(nid_day)  
          endif  
       ENDIF  
   
     End subroutine write_histday  
   
     !****************************  
   
     subroutine write_histhf  
   
       ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09  
   
       !------------------------------------------------  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
1060    
1061      end subroutine write_histhf      DO nsrf = 1, nbsrf
1062           CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1063      !***************************************************************         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1064           CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1065      subroutine write_histins         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1066           CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1067        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1068           CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1069        real zout         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1070        integer itau_w  ! pas de temps ecriture         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1071           CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1072        !--------------------------------------------------         CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1073        END DO
       IF (ok_instan) THEN  
          ! Champs 2D:  
   
          zsto = pdtphys * ecrit_ins  
          zout = pdtphys * ecrit_ins  
          itau_w = itau_phy + itap  
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)  
          CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)  
   
          i = NINT(zout/zsto)  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)  
          CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = paprs(i, 1)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)  
          !ccIM  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon)=-1*sens(1:klon)  
          !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
   
          DO nsrf = 1, nbsrf  
             !XXX  
             zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
          END DO  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)  
   
          !IM cf. AM 081204 BEG  
   
          !HBTM2  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)  
   
          !IM cf. AM 081204 END  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
   
          if (ok_sync) then  
             call histsync(nid_ins)  
          endif  
       ENDIF  
   
     end subroutine write_histins  
   
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09  
   
       integer itau_w  ! pas de temps ecriture  
   
       !-------------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       ! Champs 3D:  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)  
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)  
   
       if (nbtr >= 3) then  
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &  
               zx_tmp_3d)  
          CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)  
       end if  
1074    
1075        if (ok_sync) then      CALL histwrite_phy("albs", albsol)
1076           call histsync(nid_hf3d)      CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1077        endif      CALL histwrite_phy("rugs", zxrugs)
1078        CALL histwrite_phy("s_pblh", s_pblh)
1079        CALL histwrite_phy("s_pblt", s_pblt)
1080        CALL histwrite_phy("s_lcl", s_lcl)
1081        CALL histwrite_phy("s_capCL", s_capCL)
1082        CALL histwrite_phy("s_oliqCL", s_oliqCL)
1083        CALL histwrite_phy("s_cteiCL", s_cteiCL)
1084        CALL histwrite_phy("s_therm", s_therm)
1085        CALL histwrite_phy("s_trmb1", s_trmb1)
1086        CALL histwrite_phy("s_trmb2", s_trmb2)
1087        CALL histwrite_phy("s_trmb3", s_trmb3)
1088    
1089        if (conv_emanuel) then
1090           CALL histwrite_phy("ptop", ema_pct)
1091           CALL histwrite_phy("dnwd0", - mp)
1092        end if
1093    
1094        CALL histwrite_phy("temp", t_seri)
1095        CALL histwrite_phy("vitu", u_seri)
1096        CALL histwrite_phy("vitv", v_seri)
1097        CALL histwrite_phy("geop", zphi)
1098        CALL histwrite_phy("pres", play)
1099        CALL histwrite_phy("dtvdf", d_t_vdf)
1100        CALL histwrite_phy("dqvdf", d_q_vdf)
1101        CALL histwrite_phy("rhum", zx_rh)
1102        CALL histwrite_phy("d_t_ec", d_t_ec)
1103        CALL histwrite_phy("dtsw0", heat0 / 86400.)
1104        CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1105        CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1106        call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1107    
1108        if (ok_instan) call histsync(nid_ins)
1109    
1110        IF (lafin) then
1111           call NF95_CLOSE(ncid_startphy)
1112           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1113                fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1114                radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1115                t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1116                w01)
1117        end IF
1118    
1119      end subroutine write_histhf3d      firstcal = .FALSE.
1120    
1121    END SUBROUTINE physiq    END SUBROUTINE physiq
1122    

Legend:
Removed from v.32  
changed lines
  Added in v.226

  ViewVC Help
Powered by ViewVC 1.1.21