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

Legend:
Removed from v.17  
changed lines
  Added in v.212

  ViewVC Help
Powered by ViewVC 1.1.21