/[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 16 by guez, Fri Aug 1 15:37:00 2008 UTC trunk/phylmd/physiq.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 1  Line 1 
1  module physiq_m  module physiq_m
2    
   ! This module is clean: no C preprocessor directive, no include line.  
   
3    IMPLICIT none    IMPLICIT none
4    
   private  
   public physiq  
   
5  contains  contains
6    
7    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, presnivs, u, v, t, qx, omega, d_u, d_v, &         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)
9         d_t, d_qx, d_ps, dudyn, PVteta)  
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! (subversion revision 678)
   
     ! 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  
12    
13      ! Declaration des constantes et des fonctions thermodynamiques :      ! Author: Z.X. Li (LMD/CNRS) 1993
     use fcttre, only: thermcep, foeew, qsats, qsatl  
14    
15      ! Variables argument:      ! This is the main procedure for the "physics" part of the program.
16    
17        use aaam_bud_m, only: aaam_bud
18        USE abort_gcm_m, ONLY: abort_gcm
19        use aeropt_m, only: aeropt
20        use ajsec_m, only: ajsec
21        USE calendar, ONLY: ymds2ju
22        use calltherm_m, only: calltherm
23        USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
24             ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
25        USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
26             ok_orodr, ok_orolf, soil_model
27        USE clmain_m, ONLY: clmain
28        use clouds_gno_m, only: clouds_gno
29        USE comgeomphy, ONLY: airephy, cuphy, cvphy
30        USE concvl_m, ONLY: concvl
31        USE conf_gcm_m, ONLY: offline, raz_date
32        USE conf_phys_m, ONLY: conf_phys
33        use conflx_m, only: conflx
34        USE ctherm, ONLY: iflag_thermals, nsplit_thermals
35        use diagcld2_m, only: diagcld2
36        use diagetpq_m, only: diagetpq
37        use diagphy_m, only: diagphy
38        USE dimens_m, ONLY: llm, nqmx
39        USE dimphy, ONLY: klon, nbtr
40        USE dimsoil, ONLY: nsoilmx
41        use drag_noro_m, only: drag_noro
42        USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43        use fisrtilp_m, only: fisrtilp
44        USE hgardfou_m, ONLY: hgardfou
45        USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
46             nbsrf
47        USE ini_histins_m, ONLY: ini_histins
48        use newmicro_m, only: newmicro
49        USE oasis_m, ONLY: ok_oasis
50        USE orbite_m, ONLY: orbite, zenang
51        USE ozonecm_m, ONLY: ozonecm
52        USE phyetat0_m, ONLY: phyetat0, rlat, rlon
53        USE phyredem_m, ONLY: phyredem
54        USE phystokenc_m, ONLY: phystokenc
55        USE phytrac_m, ONLY: phytrac
56        USE qcheck_m, ONLY: qcheck
57        use radlwsw_m, only: radlwsw
58        use readsulfate_m, only: readsulfate
59        use sugwd_m, only: sugwd
60        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61        USE temps, ONLY: annee_ref, day_ref, itau_phy
62        use unit_nml_m, only: unit_nml
63        USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      logical, intent(in):: lafin ! dernier passage
66    
67      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
68      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
69    
70      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
71      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
     logical, intent(in):: lafin ! dernier passage  
72    
73      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
74      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
75    
76      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
78    
79      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
80      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
81    
82      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
83    
84      REAL presnivs(llm)      REAL, intent(in):: u(klon, llm)
85      ! (input pressions approximat. des milieux couches ( en PA))      ! vitesse dans la direction X (de O a E) en m/s
86    
87      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
88      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL, intent(in):: t(klon, llm) ! input temperature (K)
     REAL t(klon, llm)  ! input temperature (K)  
   
     REAL, intent(in):: qx(klon, llm, nq)  
     ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)  
   
     REAL omega(klon, llm)  ! input vitesse verticale en Pa/s  
     REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)  
     REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
     REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)  
     REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon)  ! output tendance physique de la pression au sol  
89    
90      INTEGER nbteta      REAL, intent(in):: qx(klon, llm, nqmx)
91      PARAMETER(nbteta=3)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
92    
93      REAL PVteta(klon, nbteta)      REAL, intent(in):: omega(klon, llm) ! vitesse verticale en Pa/s
94      ! (output vorticite potentielle a des thetas constantes)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m s-2)
95        REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m s-2)
96        REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
97        REAL, intent(out):: d_qx(klon, llm, nqmx) ! tendance physique de "qx" (s-1)
98    
99        ! Local:
100    
101        LOGICAL:: firstcal = .true.
102    
103        INTEGER nbteta
104        PARAMETER(nbteta = 3)
105    
     LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
106      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
107      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
108    
109      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
110      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
111      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
112      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
113        ! Ajouter artificiellement les stratus
114    
115      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
116      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
117      logical rnpb      logical rnpb
118      parameter(rnpb=.true.)      parameter(rnpb = .true.)
   
     character(len=6), save:: ocean  
     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")  
119    
120      logical ok_ocean      character(len = 6):: ocean = 'force '
121      SAVE ok_ocean      ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais
122        ! pas "couple")
123      !IM "slab" ocean  
124      REAL tslab(klon)    !Temperature du slab-ocean      ! "slab" ocean
125      SAVE tslab      REAL, save:: tslab(klon) ! temperature of ocean slab
126      REAL seaice(klon)   !glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
127      SAVE seaice      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
128      REAL fluxo(klon)    !flux turbulents ocean-glace de mer      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
129    
130      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
131      logical ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     save ok_veget  
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
132    
133      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
134      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
135        ! fichiers histday, histmth et histins
136    
137      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
138      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
139    
140      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
141      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
142      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
143      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
144      save q2  
145        INTEGER ivap ! indice de traceurs pour vapeur d'eau
146        PARAMETER (ivap = 1)
147        INTEGER iliq ! indice de traceurs pour eau liquide
148        PARAMETER (iliq = 2)
149    
150      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
151      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  
152    
153      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
154      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)
155    
156      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
157    
158      !IM Amip2 PV a theta constante      ! Amip2 PV a theta constante
159    
160      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
161      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
162      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
163      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
164    
165      !MI Amip2 PV a theta constante      ! Amip2 PV a theta constante
166    
167      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
168      PARAMETER(klevp1=llm+1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
169      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
170    
171      REAL SWdn200clr(klon), SWdn200(klon)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
172      REAL SWup200clr(klon), SWup200(klon)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
     REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)  
     REAL lwup0(klon, klevp1), lwup(klon, klevp1)  
173      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
174    
175      REAL LWdn200clr(klon), LWdn200(klon)      ! Amip2
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
     !IM Amip2  
176      ! variables a une pression donnee      ! variables a une pression donnee
177    
178      integer nlevSTD      integer nlevSTD
179      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
180      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
181      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
182           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
183           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
184      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
185      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
186           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
187           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
   
     real tlevSTD(klon, nlevSTD), qlevSTD(klon, nlevSTD)  
     real rhlevSTD(klon, nlevSTD), philevSTD(klon, nlevSTD)  
     real ulevSTD(klon, nlevSTD), vlevSTD(klon, nlevSTD)  
     real wlevSTD(klon, nlevSTD)  
   
     ! nout : niveau de output des variables a une pression donnee  
     INTEGER nout  
     PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC  
   
     REAL tsumSTD(klon, nlevSTD, nout)  
     REAL usumSTD(klon, nlevSTD, nout), vsumSTD(klon, nlevSTD, nout)  
     REAL wsumSTD(klon, nlevSTD, nout), phisumSTD(klon, nlevSTD, nout)  
     REAL qsumSTD(klon, nlevSTD, nout), rhsumSTD(klon, nlevSTD, nout)  
   
     SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,  &  
          qsumSTD, rhsumSTD  
   
     logical oknondef(klon, nlevSTD, nout)  
     real tnondef(klon, nlevSTD, nout)  
     save tnondef  
   
     ! les produits uvSTD, vqSTD, .., T2STD sont calcules  
     ! a partir des valeurs instantannees toutes les 6 h  
     ! qui sont moyennees sur le mois  
   
     real uvSTD(klon, nlevSTD)  
     real vqSTD(klon, nlevSTD)  
     real vTSTD(klon, nlevSTD)  
     real wqSTD(klon, nlevSTD)  
   
     real uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
     real vphisumSTD(klon, nlevSTD, nout)  
     real wTsumSTD(klon, nlevSTD, nout)  
     real u2sumSTD(klon, nlevSTD, nout)  
     real v2sumSTD(klon, nlevSTD, nout)  
     real T2sumSTD(klon, nlevSTD, nout)  
   
     SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD  
     SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD  
     !MI Amip2  
188    
189      ! prw: precipitable water      ! prw: precipitable water
190      real prw(klon)      real prw(klon)
# Line 268  contains Line 194  contains
194      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
195      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
196    
197      INTEGER l, kmax, lmax      INTEGER kmax, lmax
198      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
199      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
200      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
201    
202      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
203      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
204      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
205    
206      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 282  contains Line 208  contains
208      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
209    
210      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
211      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
212    
213      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
214      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
215      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
216    
217      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
218      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
219           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
220           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 315  contains Line 241  contains
241           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &           'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &
242           'pc= 680-800hPa, tau> 60.'/           'pc= 680-800hPa, tau> 60.'/
243    
244      !IM ISCCP simulator v3.4      ! ISCCP simulator v3.4
245    
246      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
247      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
248    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
249      ! Variables propres a la physique      ! Variables propres a la physique
250    
251      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 330  contains Line 253  contains
253      ! "physiq".)      ! "physiq".)
254    
255      REAL radsol(klon)      REAL radsol(klon)
256      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
257    
258      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
259    
260      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
261    
262      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
263      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
264    
265      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap                 ! evaporation  
266      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
267      SAVE fluxlat      SAVE fluxlat
268    
269      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
270      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
271    
272      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
273    
274      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
275      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
276    
277      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
278      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
279      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
280      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
281    
282      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
283      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
284      REAL, save:: zstd(klon) ! deviation standard de l'OESM      REAL, save:: zstd(klon) ! deviation standard de l'OESM
285      REAL, save:: zsig(klon) ! pente de l'OESM      REAL, save:: zsig(klon) ! pente de l'OESM
# Line 374  contains Line 294  contains
294      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
295    
296      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
297      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
298    
299      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
300      SAVE run_off_lic_0      SAVE run_off_lic_0
301      !KE43      !KE43
302      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
303    
304      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
305      SAVE bas      SAVE bas
306      SAVE top      SAVE top
307    
308      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
309      SAVE Ma      SAVE Ma
310      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
311      SAVE qcondc      SAVE qcondc
312      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
313      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd       ! sb  
314    
315      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
316    
# Line 402  contains Line 319  contains
319      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
320      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
321    
322      !AA  Pour phytrac      ! Pour phytrac :
323      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
324      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
325      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
326      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
327      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
328      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
329      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
330      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
331    
332      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 421  contains Line 338  contains
338      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
339      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
340    
341      !AA      REAL, save:: rain_fall(klon) ! pluie
342      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
343      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
344      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
345    
346      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
347      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
348      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
349      SAVE dlw      SAVE dlw
350      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
351      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 449  contains Line 364  contains
364      INTEGER julien      INTEGER julien
365    
366      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
367      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
368      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
369    
     SAVE pctsrf                 ! sous-fraction du sol  
370      REAL albsol(klon)      REAL albsol(klon)
371      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
372      REAL albsollw(klon)      REAL albsollw(klon)
373      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
374    
375      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
376    
377      ! Declaration des procedures appelees      ! Declaration des procedures appelees
378    
379      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec     ! ajustement sec  
     EXTERNAL clmain    ! couche limite  
380      !KE43      !KE43
381      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
382      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL nuage ! calculer les proprietes radiatives
383      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL ozonecm   ! prescrire l'ozone  
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
384    
385      ! Variables locales      ! Variables locales
386    
387      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
388      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
389    
390      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
391      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
392      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
393      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
394      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
395      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
396      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
397    
398      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
399      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
400      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
401      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
402    
403      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
404      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
405      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
406      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
407    
408      REAL heat(klon, llm)    ! chauffage solaire      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
409      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! les variables soient r\'emanentes.
410      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
411      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
412      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
413      real sollwdown(klon)    ! downward LW flux at surface      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
414      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
415        REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
416        real, save:: sollwdown(klon) ! downward LW flux at surface
417        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
418      REAL albpla(klon)      REAL albpla(klon)
419      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
420      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
421      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla
422      !                      sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
423    
424      INTEGER itaprad      INTEGER itaprad
425      SAVE itaprad      SAVE itaprad
426    
427      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
428      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
429    
430      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
431      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 528  contains Line 435  contains
435      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
436      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
437      real zlongi      real zlongi
   
438      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
439      REAL za, zb      REAL za, zb
440      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
441      real zqsat(klon, llm)      real zqsat(klon, llm)
442      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
443      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup=234.0)  
   
444      REAL zphi(klon, llm)      REAL zphi(klon, llm)
445    
446      !IM cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables locales pour la CLA (hbtm2)
447    
448      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
449      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
450      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
451      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
452      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
453      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
454      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
455      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
456      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
457      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
458      ! Grdeurs de sorties      ! Grdeurs de sorties
459      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
460      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
461      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
462      REAL s_trmb3(klon)      REAL s_trmb3(klon)
463    
464      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
465    
466      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
467      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
468      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
469      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
470      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
471      SAVE cape      SAVE cape
472    
473      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
474      SAVE pbase      SAVE pbase
475      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
476      SAVE bbase      SAVE bbase
477      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
478      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
479      ! -- convect43:      ! -- convect43:
     INTEGER ntra              ! nb traceurs pour convect4.3  
480      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
481      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
482    
483      ! Variables du changement      ! Variables du changement
484    
485      ! con: convection      ! con: convection
486      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
487      ! ajs: ajustement sec      ! ajs: ajustement sec
488      ! eva: evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
489      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
490      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
491      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
492      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
# Line 593  contains Line 494  contains
494      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
495      REAL rneb(klon, llm)      REAL rneb(klon, llm)
496    
497      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
498      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
499      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
500      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
501      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
502      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)  
503    
504      SAVE ibas_con, itop_con      INTEGER, save:: ibas_con(klon), itop_con(klon)
505    
506      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
507      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 616  contains Line 515  contains
515      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
516      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
517    
518      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
519      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
520      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
521    
522      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
523      real fact_cldcon      real:: fact_cldcon = 0.375
524      real facttemps      real:: facttemps = 1.e-4
525      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
     save fact_cldcon, facttemps  
526      real facteur      real facteur
527    
528      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
529      logical ptconv(klon, llm)      logical ptconv(klon, llm)
530    
531      ! Variables liees a l'ecriture de la bande histoire physique      ! Variables locales pour effectuer les appels en s\'erie :
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
     ! Variables locales pour effectuer les appels en serie  
532    
533      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
534      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 647  contains Line 538  contains
538      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
539    
540      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
541    
542      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
543      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
544      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
545      REAL aam, torsfc      REAL aam, torsfc
546    
547      REAL dudyn(iim+1, jjm + 1, llm)      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
   
     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)  
548    
549      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
550    
# Line 669  contains Line 554  contains
554      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.
555    
556      REAL zsto      REAL zsto
   
     character(len=20) modname  
     character(len=80) abort_message  
     logical ok_sync  
557      real date0      real date0
558    
559      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
560      REAL ztsol(klon)      REAL ztsol(klon)
561      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
562      REAL      d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
563      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
564      SAVE      d_h_vcol_phy      REAL zero_v(klon)
565      REAL      zero_v(klon)      CHARACTER(LEN = 15) tit
566      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
567      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
568      SAVE      ip_ebil  
569      DATA      ip_ebil/0/      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique
     INTEGER   if_ebil ! level for energy conserv. dignostics  
     SAVE      if_ebil  
     !+jld ec_conser  
     REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique  
570      REAL ZRCPD      REAL ZRCPD
571      !-jld ec_conser  
572      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
573      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
574      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
575      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
576      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille  
577      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      ! Aerosol effects:
578      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]  
579        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
580      REAL sulfate_pi(klon, llm)  
581      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      REAL, save:: sulfate_pi(klon, llm)
582      SAVE sulfate_pi      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
583    
584      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
585      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
586    
587      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
588      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
589    
590      ! Aerosol optical properties      ! Aerosol optical properties
591      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
592      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
593    
594      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
595      ! ok_ade=T -ADE=topswad-topsw      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
596    
597      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL aerindex(klon) ! POLDER aerosol index
     ! ok_aie=T ->  
     !        ok_ade=T -AIE=topswai-topswad  
     !        ok_ade=F -AIE=topswai-topsw  
598    
599      REAL aerindex(klon)       ! POLDER aerosol index      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
600        LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
601    
602      ! Parameters      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
603      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
604      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      ! B). They link cloud droplet number concentration to aerosol mass
605        ! concentration.
606    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
607      SAVE u10m      SAVE u10m
608      SAVE v10m      SAVE v10m
609      SAVE t2m      SAVE t2m
610      SAVE q2m      SAVE q2m
611      SAVE ffonte      SAVE ffonte
612      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
613      SAVE rain_con      SAVE rain_con
614      SAVE snow_con      SAVE snow_con
615      SAVE topswai      SAVE topswai
# Line 746  contains Line 618  contains
618      SAVE solswad      SAVE solswad
619      SAVE d_u_con      SAVE d_u_con
620      SAVE d_v_con      SAVE d_v_con
621      SAVE rnebcon0  
622      SAVE clwcon0      real zmasse(klon, llm)
623      SAVE pblh      ! (column-density of mass of air in a cell, in kg m-2)
624      SAVE plcl  
625      SAVE capCL      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
626      SAVE oliqCL  
627      SAVE cteiCL      namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
628      SAVE pblt           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
629      SAVE therm           ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
630      SAVE trmb1           nsplit_thermals
     SAVE trmb2  
     SAVE trmb3  
631    
632      !----------------------------------------------------------------      !----------------------------------------------------------------
633    
634      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
635      IF (if_ebil >= 1) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
636         DO i=1, klon           'eaux vapeur et liquide sont indispensables', 1)
           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  
637    
638      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
639         !  initialiser         ! initialiser
640         u10m=0.         u10m = 0.
641         v10m=0.         v10m = 0.
642         t2m=0.         t2m = 0.
643         q2m=0.         q2m = 0.
644         ffonte=0.         ffonte = 0.
645         fqcalving=0.         fqcalving = 0.
646         piz_ae(:, :, :)=0.         piz_ae = 0.
647         tau_ae(:, :, :)=0.         tau_ae = 0.
648         cg_ae(:, :, :)=0.         cg_ae = 0.
649         rain_con(:)=0.         rain_con(:) = 0.
650         snow_con(:)=0.         snow_con(:) = 0.
651         bl95_b0=0.         topswai(:) = 0.
652         bl95_b1=0.         topswad(:) = 0.
653         topswai(:)=0.         solswai(:) = 0.
654         topswad(:)=0.         solswad(:) = 0.
655         solswai(:)=0.  
656         solswad(:)=0.         d_u_con = 0.
657           d_v_con = 0.
658         d_u_con = 0.0         rnebcon0 = 0.
659         d_v_con = 0.0         clwcon0 = 0.
660         rnebcon0 = 0.0         rnebcon = 0.
661         clwcon0 = 0.0         clwcon = 0.
662         rnebcon = 0.0  
663         clwcon = 0.0         pblh =0. ! Hauteur de couche limite
664           plcl =0. ! Niveau de condensation de la CLA
665         pblh   =0.        ! Hauteur de couche limite         capCL =0. ! CAPE de couche limite
666         plcl   =0.        ! Niveau de condensation de la CLA         oliqCL =0. ! eau_liqu integree de couche limite
667         capCL  =0.        ! CAPE de couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
668         oliqCL =0.        ! eau_liqu integree de couche limite         pblt =0. ! T a la Hauteur de couche limite
669         cteiCL =0.        ! cloud top instab. crit. couche limite         therm =0.
670         pblt   =0.        ! T a la Hauteur de couche limite         trmb1 =0. ! deep_cape
671         therm  =0.         trmb2 =0. ! inhibition
672         trmb1  =0.        ! deep_cape         trmb3 =0. ! Point Omega
673         trmb2  =0.        ! inhibition  
674         trmb3  =0.        ! Point Omega         IF (if_ebil >= 1) d_h_vcol_phy = 0.
675    
676         IF (if_ebil >= 1) d_h_vcol_phy=0.         iflag_thermals = 0
677           nsplit_thermals = 1
678         ! appel a la lecture du run.def physique         print *, "Enter namelist 'physiq_nml'."
679           read(unit=*, nml=physiq_nml)
680         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         write(unit_nml, nml=physiq_nml)
681              ok_instan, fact_cldcon, facttemps, ok_newmicro, &  
682              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &         call conf_phys
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
683    
684         ! Initialiser les compteurs:         ! Initialiser les compteurs:
685    
# Line 828  contains Line 687  contains
687         itap = 0         itap = 0
688         itaprad = 0         itaprad = 0
689         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
690              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
691              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
692              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
693              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
694    
695         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
696         q2(:, :, :)=1.e-8         q2 = 1e-8
697    
698         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
699    
700         ! on remet le calendrier a zero         ! on remet le calendrier a zero
701         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
702    
703         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
704           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
705                ok_instan, ok_region)
706    
707         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
708            ok_ocean=.TRUE.            print *, "Au minimum 4 appels par jour si cycle diurne"
709         ENDIF            call abort_gcm('physiq', &
710                   "Nombre d'appels au rayonnement insuffisant", 1)
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN  
           print *,'Nbre d appels au rayonnement insuffisant'  
           print *,"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
711         ENDIF         ENDIF
        print *,"Clef pour la convection, iflag_con=", iflag_con  
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
712    
713         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le sch\'ema de convection d'Emanuel :
714         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
715              ibas_con = 1
716            print *,"*** Convection de Kerry Emanuel 4.3  "            itop_con = 1
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
           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  
   
717         ENDIF         ENDIF
718    
719         IF (ok_orodr) THEN         IF (ok_orodr) THEN
720            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
721            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(paprs, play)
722         else         else
723            rugoro = 0.            rugoro = 0.
724         ENDIF         ENDIF
725    
726         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
727         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
728    
729         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
730         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
731         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
732         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
733         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
734    
735         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
736    
737         npas = 0         npas = 0
738         nexca = 0         nexca = 0
739    
740         print *,'AVANT HIST IFLAG_CON=', iflag_con         ! Initialisation des sorties
741    
742         !   Initialisation des sorties         call ini_histins(dtphys, ok_instan, nid_ins)
   
        call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)  
        call ini_histday(pdtphys, presnivs, ok_journe, nid_day)  
        call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)  
743         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
744         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
745         WRITE(*, *) 'physiq date0 : ', date0         print *, 'physiq date0: ', date0
746      ENDIF test_firstcal      ENDIF test_firstcal
747    
748      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
749        da = 0.
750        mp = 0.
751        phi = 0.
752    
753      DO i = 1, klon      ! We will modify variables *_seri and we will not touch variables
754         d_ps(i) = 0.0      ! u, v, h, q:
     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  
   
755      DO k = 1, llm      DO k = 1, llm
756         DO i = 1, klon         DO i = 1, klon
757            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
758            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
759            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
760            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
761            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
762            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
763         ENDDO         ENDDO
764      ENDDO      ENDDO
765      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
766         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
767      ELSE      ELSE
768         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
769      ENDIF      ENDIF
# Line 960  contains Line 778  contains
778      ENDDO      ENDDO
779    
780      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
781         ztit='after dynamic'         tit = 'after dynamics'
782         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
783              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
784              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
785         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajout\'es dans la
786         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
787         !     est egale a la variation de la physique au pas de temps precedent.         !  \^etre \'egale \`a la variation de la physique au pas de temps
788         !     Donc la somme de ces 2 variations devrait etre nulle.         !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre
789         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
790              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
791              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
792              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
793      END IF      END IF
794    
795      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
796      IF (ancien_ok) THEN      IF (ancien_ok) THEN
797         DO k = 1, llm         DO k = 1, llm
798            DO i = 1, klon            DO i = 1, klon
799               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
800               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
801            ENDDO            ENDDO
802         ENDDO         ENDDO
803      ELSE      ELSE
804         DO k = 1, llm         DO k = 1, llm
805            DO i = 1, klon            DO i = 1, klon
806               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
807               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
808            ENDDO            ENDDO
809         ENDDO         ENDDO
810         ancien_ok = .TRUE.         ancien_ok = .TRUE.
811      ENDIF      ENDIF
812    
813      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
814      DO k = 1, llm      DO k = 1, llm
815         DO i = 1, klon         DO i = 1, klon
816            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
817         ENDDO         ENDDO
818      ENDDO      ENDDO
819    
820      ! Verifier les temperatures      ! Check temperatures:
   
821      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
822    
823      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
824      itap = itap + 1      itap = itap + 1
825      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
826      if (julien == 0) julien = 360      if (julien == 0) julien = 360
827    
828      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
829    
830      IF (MOD(itap - 1, lmt_pas) == 0) THEN      ! Mettre en action les conditions aux limites (albedo, sst etc.).
        CALL ozonecm(REAL(julien), rlat, paprs, wo)  
     ENDIF  
831    
832      ! Re-evaporer l'eau liquide nuageuse      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
833        wo = ozonecm(REAL(julien), paprs)
834    
835      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      ! \'Evaporation de l'eau liquide nuageuse :
836        DO k = 1, llm
837         DO i = 1, klon         DO i = 1, klon
838            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
839            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
840            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  
841            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
842         ENDDO         ENDDO
843      ENDDO      ENDDO
844        ql_seri = 0.
845    
846      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
847         ztit='after reevap'         tit = 'after reevap'
848         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
849              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
850              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
851         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
852              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
853              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
854    
855      END IF      END IF
856    
857      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
858    
859      DO i = 1, klon      DO i = 1, klon
860         zxrugs(i) = 0.0         zxrugs(i) = 0.
861      ENDDO      ENDDO
862      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
863         DO i = 1, klon         DO i = 1, klon
# Line 1068  contains Line 874  contains
874    
875      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
876      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
877         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
878         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
879      ELSE      ELSE
880         rmu0 = -999.999         rmu0 = -999.999
881      ENDIF      ENDIF
882    
883      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
884      albsol(:)=0.      albsol(:) = 0.
885      albsollw(:)=0.      albsollw(:) = 0.
886      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
887         DO i = 1, klon         DO i = 1, klon
888            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1084  contains Line 890  contains
890         ENDDO         ENDDO
891      ENDDO      ENDDO
892    
893      !     Repartition sous maille des flux LW et SW      ! R\'epartition sous maille des flux longwave et shortwave
894      ! Repartition du longwave par sous-surface linearisee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
895    
896      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
897         DO i = 1, klon         DO i = 1, klon
898            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
899                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
900            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
901         ENDDO         ENDDO
902      ENDDO      ENDDO
903    
904      fder = dlw      fder = dlw
905    
906      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
907           t_seri, q_seri, u_seri, v_seri, &  
908           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
909           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
910           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
911           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
912           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
913           fluxlat, rain_fall, snow_fall, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
914           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
915           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
916           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
917           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
918           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
919           q2, dsens, devap, &      ! Incr\'ementation des flux
920           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
921           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
922           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
923           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
924           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
925      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
926         DO k = 1, llm         DO k = 1, llm
927            DO i = 1, klon            DO i = 1, klon
928               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
929                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
930               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
931                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(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)  
932            END DO            END DO
933         END DO         END DO
934      END DO      END DO
935      DO i = 1, klon      DO i = 1, klon
936         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
937         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol
938         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
939      ENDDO      ENDDO
940    
# Line 1153  contains Line 948  contains
948      ENDDO      ENDDO
949    
950      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
951         ztit='after clmain'         tit = 'after clmain'
952         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
953              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
954              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
955         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
956              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
957              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
958      END IF      END IF
959    
960      ! Incrementer la temperature du sol      ! Update surface temperature:
961    
962      DO i = 1, klon      DO i = 1, klon
963         zxtsol(i) = 0.0         zxtsol(i) = 0.
964         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
965    
966         zt2m(i) = 0.0         zt2m(i) = 0.
967         zq2m(i) = 0.0         zq2m(i) = 0.
968         zu10m(i) = 0.0         zu10m(i) = 0.
969         zv10m(i) = 0.0         zv10m(i) = 0.
970         zxffonte(i) = 0.0         zxffonte(i) = 0.
971         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
972    
973         s_pblh(i) = 0.0         s_pblh(i) = 0.
974         s_lcl(i) = 0.0         s_lcl(i) = 0.
975         s_capCL(i) = 0.0         s_capCL(i) = 0.
976         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
977         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
978         s_pblT(i) = 0.0         s_pblT(i) = 0.
979         s_therm(i) = 0.0         s_therm(i) = 0.
980         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
981         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
982         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
983    
984         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
985              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
986              THEN              'physiq : probl\`eme sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i,  &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
987      ENDDO      ENDDO
988      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
989         DO i = 1, klon         DO i = 1, klon
# Line 1206  contains Line 996  contains
996            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
997            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
998            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
999            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1000                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1001            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1002            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)
# Line 1225  contains Line 1015  contains
1015    
1016      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1017         DO i = 1, klon         DO i = 1, klon
1018            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1019    
1020            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1021            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1022            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1023            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1024            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1025            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1026                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1027            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1028            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1029            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1030            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1031            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1032            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1033            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1034            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1035            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1036            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1037         ENDDO         ENDDO
1038      ENDDO      ENDDO
1039    
1040      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1041    
1042      DO i = 1, klon      DO i = 1, klon
1043         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1044      ENDDO      ENDDO
1045    
1046      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1047    
1048      DO k = 1, llm      DO k = 1, llm
1049         DO i = 1, klon         DO i = 1, klon
1050            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1051                 + d_q_vdf(i, k)/pdtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k)  &  
                + d_t_vdf(i, k)/pdtphys  
1052         ENDDO         ENDDO
1053      ENDDO      ENDDO
1054    
1055      IF (check) THEN      IF (check) THEN
1056         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1057         print *, "avantcon=", za         print *, "avantcon = ", za
1058      ENDIF      ENDIF
1059      zx_ajustq = .FALSE.  
1060      IF (iflag_con == 2) zx_ajustq=.TRUE.      if (iflag_con == 2) then
1061      IF (zx_ajustq) THEN         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1062         DO i = 1, klon         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1063            z_avant(i) = 0.0              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1064         ENDDO              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1065         DO k = 1, llm              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1066            DO i = 1, klon              kdtop, pmflxr, pmflxs)
              z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *(paprs(i, k)-paprs(i, k+1))/RG  
           ENDDO  
        ENDDO  
     ENDIF  
     IF (iflag_con == 1) THEN  
        stop 'reactiver le call conlmd dans physiq.F'  
     ELSE IF (iflag_con == 2) THEN  
        CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &  
             conv_t, conv_q, zxfluxq(1, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, &  
             pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
1067         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1068         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1069         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1070            ibas_con(i) = llm+1 - kcbot(i)         itop_con = llm + 1 - kctop
1071            itop_con(i) = llm+1 - kctop(i)      else
1072         ENDDO         ! iflag_con >= 3
     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  
1073    
1074         IF (.NOT. ok_gust) THEN         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1075            do i = 1, klon              v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1076               wd(i)=0.0              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1077            enddo              itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1078         ENDIF              pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1079                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1080           ! (number of tracers for the convection scheme of Kerry Emanuel:
1081           ! la partie traceurs est faite dans phytrac
1082           ! on met ntra = 1 pour limiter les appels mais on peut
1083           ! supprimer les calculs / ftra.)
1084    
1085           clwcon0 = qcondc
1086           mfu = upwd + dnwd
1087           IF (.NOT. ok_gust) wd = 0.
1088    
1089         ! Calcul des proprietes des nuages convectifs         ! Calcul des propri\'et\'es des nuages convectifs
1090    
1091         DO k = 1, llm         DO k = 1, llm
1092            DO i = 1, klon            DO i = 1, klon
1093               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1094               IF (thermcep) THEN               IF (thermcep) THEN
1095                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1096                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1097                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1098                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1099                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1100               ELSE               ELSE
1101                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1102                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1103                  ELSE                  ELSE
1104                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1105                  ENDIF                  ENDIF
1106               ENDIF               ENDIF
1107               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1108            ENDDO            ENDDO
1109         ENDDO         ENDDO
1110    
1111         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1112         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1113         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1114              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1115      ELSE  
1116         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1117         stop 1         pen_u = 0.
1118      ENDIF         pen_d = 0.
1119           pde_d = 0.
1120           pde_u = 0.
1121        END if
1122    
1123      DO k = 1, llm      DO k = 1, llm
1124         DO i = 1, klon         DO i = 1, klon
# Line 1380  contains Line 1130  contains
1130      ENDDO      ENDDO
1131    
1132      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1133         ztit='after convect'         tit = 'after convect'
1134         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1135              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1136              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1137         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1138              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1139              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1140      END IF      END IF
1141    
1142      IF (check) THEN      IF (check) THEN
1143         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1144         print *,"aprescon=", za         print *, "aprescon = ", za
1145         zx_t = 0.0         zx_t = 0.
1146         za = 0.0         za = 0.
1147         DO i = 1, klon         DO i = 1, klon
1148            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1149            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1150                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1151         ENDDO         ENDDO
1152         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1153         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1154      ENDIF      ENDIF
1155      IF (zx_ajustq) THEN  
1156         DO i = 1, klon      IF (iflag_con == 2) THEN
1157            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1158         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &  
                   *(paprs(i, k)-paprs(i, k+1))/RG  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &  
                /z_apres(i)  
        ENDDO  
1159         DO k = 1, llm         DO k = 1, llm
1160            DO i = 1, klon            DO i = 1, klon
1161               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  
1162                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1163               ENDIF               ENDIF
1164            ENDDO            ENDDO
1165         ENDDO         ENDDO
1166      ENDIF      ENDIF
     zx_ajustq=.FALSE.  
1167    
1168      ! Convection seche (thermiques ou ajustement)      ! Convection s\`eche (thermiques ou ajustement)
1169    
1170      d_t_ajs=0.      d_t_ajs = 0.
1171      d_u_ajs=0.      d_u_ajs = 0.
1172      d_v_ajs=0.      d_v_ajs = 0.
1173      d_q_ajs=0.      d_q_ajs = 0.
1174      fm_therm=0.      fm_therm = 0.
1175      entr_therm=0.      entr_therm = 0.
1176    
1177      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1178           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1179           , 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)  
1180         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1181         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1182      else      else
1183         !  Thermiques         ! Thermiques
1184         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1185              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
        call calltherm(pdtphys &  
             , pplay, paprs, pphi &  
             , u_seri, v_seri, t_seri, q_seri &  
             , d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs &  
             , fm_therm, entr_therm)  
1186      endif      endif
1187    
1188      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1189         ztit='after dry_adjust'         tit = 'after dry_adjust'
1190         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1191              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1192              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1193      END IF      END IF
1194    
1195      !  Caclul des ratqs      ! Caclul des ratqs
1196    
1197      !   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
1198      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
1199      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1200         do k=1, llm         do k = 1, llm
1201            do i=1, klon            do i = 1, klon
1202               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1203                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1204                       +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)
1205               else               else
1206                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1207               endif               endif
1208            enddo            enddo
1209         enddo         enddo
1210      endif      endif
1211    
1212      !   ratqs stables      ! ratqs stables
1213      do k=1, llm      do k = 1, llm
1214         do i=1, klon         do i = 1, klon
1215            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1216                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1217         enddo         enddo
1218      enddo      enddo
1219    
1220      !  ratqs final      ! ratqs final
1221      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1222         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1223         !   ratqs final         ! ratqs final
1224         !   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
1225         !   relaxation des ratqs         ! relaxation des ratqs
1226         facteur=exp(-pdtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
1227         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs, ratqsc)
        ratqs=max(ratqs, ratqsc)  
1228      else      else
1229         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1230         ratqs=ratqss         ratqs = ratqss
1231      endif      endif
1232    
1233      ! Appeler le processus de condensation a grande echelle      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1234      ! et le processus de precipitation           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1235      CALL fisrtilp(pdtphys, paprs, pplay, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1236           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)  
1237    
1238      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1239      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1530  contains Line 1248  contains
1248      ENDDO      ENDDO
1249      IF (check) THEN      IF (check) THEN
1250         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1251         print *,"apresilp=", za         print *, "apresilp = ", za
1252         zx_t = 0.0         zx_t = 0.
1253         za = 0.0         za = 0.
1254         DO i = 1, klon         DO i = 1, klon
1255            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1256            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1257                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1258         ENDDO         ENDDO
1259         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1260         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1261      ENDIF      ENDIF
1262    
1263      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1264         ztit='after fisrt'         tit = 'after fisrt'
1265         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1266              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1267              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1268         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1269              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1270              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1271      END IF      END IF
1272    
1273      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1274    
1275      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1276    
1277      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1278         snow_tiedtke=0.         ! seulement pour Tiedtke
1279           snow_tiedtke = 0.
1280         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1281            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1282         else         else
1283            rain_tiedtke=0.            rain_tiedtke = 0.
1284            do k=1, llm            do k = 1, llm
1285               do i=1, klon               do i = 1, klon
1286                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1287                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1288                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1289                  endif                  endif
1290               enddo               enddo
1291            enddo            enddo
1292         endif         endif
1293    
1294         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1295         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1296              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1297         DO k = 1, llm         DO k = 1, llm
1298            DO i = 1, klon            DO i = 1, klon
1299               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1300                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1301                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1302               ENDIF               ENDIF
1303            ENDDO            ENDDO
1304         ENDDO         ENDDO
   
1305      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1306         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1307         ! 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
1308         ! facttemps         ! d'un facteur facttemps.
1309         facteur = pdtphys *facttemps         facteur = dtphys * facttemps
1310         do k=1, llm         do k = 1, llm
1311            do i=1, klon            do i = 1, klon
1312               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1313               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1314                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1315                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1316                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1317               endif               endif
1318            enddo            enddo
1319         enddo         enddo
1320    
1321         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1322         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1323         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1324      ENDIF      ENDIF
1325    
1326      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1327    
1328      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1329         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1330         DO k = 1, llm         DO k = 1, llm
1331            DO i = 1, klon            DO i = 1, klon
1332               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1333                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1334                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1335               ENDIF               ENDIF
# Line 1624  contains Line 1338  contains
1338      ENDIF      ENDIF
1339    
1340      ! Precipitation totale      ! Precipitation totale
   
1341      DO i = 1, klon      DO i = 1, klon
1342         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1343         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1344      ENDDO      ENDDO
1345    
1346      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1347         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1348         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
1349    
1350        ! Humidit\'e relative pour diagnostic :
1351      DO k = 1, llm      DO k = 1, llm
1352         DO i = 1, klon         DO i = 1, klon
1353            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1354            IF (thermcep) THEN            IF (thermcep) THEN
1355               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1356               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1357               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1358               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1359               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1360            ELSE            ELSE
1361               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1362                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1363               ELSE               ELSE
1364                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1365               ENDIF               ENDIF
1366            ENDIF            ENDIF
1367            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1368            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1369         ENDDO         ENDDO
1370      ENDDO      ENDDO
1371      !jq - introduce the aerosol direct and first indirect radiative forcings  
1372      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1373      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1374         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1375         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1376         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1377    
1378         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1379         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1380      ELSE      ELSE
1381         tau_ae(:, :, :)=0.0         tau_ae = 0.
1382         piz_ae(:, :, :)=0.0         piz_ae = 0.
1383         cg_ae(:, :, :)=0.0         cg_ae = 0.
1384      ENDIF      ENDIF
1385    
1386      ! Calculer les parametres optiques des nuages et quelques      ! Param\`etres optiques des nuages et quelques param\`etres pour diagnostics :
     ! parametres pour diagnostiques:  
   
1387      if (ok_newmicro) then      if (ok_newmicro) then
1388         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1389              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1390              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)  
1391      else      else
1392         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1393              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1394              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1395      endif      endif
1396    
1397      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1398      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1399         DO i = 1, klon         DO i = 1, klon
1400            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1711  contains Line 1406  contains
1406                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1407                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1408         ENDDO         ENDDO
1409         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1410         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1411              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1412              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1413              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1414              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1415              topsw, toplw, solsw, sollw, &              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
             sollwdown, &  
             topsw0, toplw0, solsw0, sollw0, &  
             lwdn0, lwdn, lwup0, lwup,  &  
             swdn0, swdn, swup0, swup, &  
             ok_ade, ok_aie, & ! new for aerosol radiative effects  
             tau_ae, piz_ae, cg_ae, &  
             topswad, solswad, &  
             cldtaupi, &  
             topswai, solswai)  
1416         itaprad = 0         itaprad = 0
1417      ENDIF      ENDIF
1418      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1735  contains Line 1421  contains
1421    
1422      DO k = 1, llm      DO k = 1, llm
1423         DO i = 1, klon         DO i = 1, klon
1424            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * pdtphys/86400.  
1425         ENDDO         ENDDO
1426      ENDDO      ENDDO
1427    
1428      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1429         ztit='after rad'         tit = 'after rad'
1430         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1431              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1432              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1433         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1434              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1435              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1436      END IF      END IF
1437    
1438      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1439      DO i = 1, klon      DO i = 1, klon
1440         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1441         zxsnow(i) = 0.0         zxsnow(i) = 0.
1442      ENDDO      ENDDO
1443      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1444         DO i = 1, klon         DO i = 1, klon
# Line 1765  contains Line 1447  contains
1447         ENDDO         ENDDO
1448      ENDDO      ENDDO
1449    
1450      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
1451    
1452      DO i = 1, klon      DO i = 1, klon
1453         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1454      ENDDO      ENDDO
1455    
1456      !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:  
1457    
1458      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1459         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1460         igwd=0         igwd = 0
1461         DO i=1, klon         DO i = 1, klon
1462            itest(i)=0            itest(i) = 0
1463            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
1464               itest(i)=1               itest(i) = 1
1465               igwd=igwd+1               igwd = igwd + 1
1466               idx(igwd)=i               idx(igwd) = i
1467            ENDIF            ENDIF
1468         ENDDO         ENDDO
1469    
1470         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1471              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1472              igwd, idx, itest, &              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1473    
1474         !  ajout des tendances         ! ajout des tendances
1475         DO k = 1, llm         DO k = 1, llm
1476            DO i = 1, klon            DO i = 1, klon
1477               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 1805  contains Line 1482  contains
1482      ENDIF      ENDIF
1483    
1484      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1485           ! S\'election des points pour lesquels le sch\'ema est actif :
1486         !  selection des points pour lesquels le shema est actif:         igwd = 0
1487         igwd=0         DO i = 1, klon
1488         DO i=1, klon            itest(i) = 0
1489            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1490            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1491               itest(i)=1               igwd = igwd + 1
1492               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1493            ENDIF            ENDIF
1494         ENDDO         ENDDO
1495    
1496         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1497              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, &  
1498              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1499    
1500         !  ajout des tendances         ! Ajout des tendances :
1501         DO k = 1, llm         DO k = 1, llm
1502            DO i = 1, klon            DO i = 1, klon
1503               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 1832  contains Line 1505  contains
1505               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)
1506            ENDDO            ENDDO
1507         ENDDO         ENDDO
1508        ENDIF
1509    
1510      ENDIF ! fin de test sur ok_orolf      ! Stress n\'ecessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
1511    
1512      DO i = 1, klon      DO i = 1, klon
1513         zustrph(i)=0.         zustrph(i) = 0.
1514         zvstrph(i)=0.         zvstrph(i) = 0.
1515      ENDDO      ENDDO
1516      DO k = 1, llm      DO k = 1, llm
1517         DO i = 1, klon         DO i = 1, klon
1518            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1519                 (paprs(i, k)-paprs(i, k+1))/rg                 * zmasse(i, k)
1520            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &            zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1521                 (paprs(i, k)-paprs(i, k+1))/rg                 * zmasse(i, k)
1522         ENDDO         ENDDO
1523      ENDDO      ENDDO
1524    
1525      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1526             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1527      CALL aaam_bud (27, klon, llm, gmtime, &  
1528           ra, rg, romega, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1529           rlat, rlon, pphis, &           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1530           zustrdr, zustrli, zustrph, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1531           zvstrdr, zvstrli, zvstrph, &  
1532           paprs, u, v, &      ! Calcul des tendances traceurs
1533           aam, torsfc)      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1534             dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1535      IF (if_ebil >= 2) THEN           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1536         ztit='after orography'           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1537         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1538              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
1539              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1540      END IF           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1541             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
     !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)  
   
     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)  
   
     ENDIF  
1542    
1543      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1544        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1545             ue, uq)
1546    
1547      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1548    
1549      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
          t_seri, q_seri, u_seri, v_seri, zphi, &  
1550           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1551    
1552      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1553    
1554      !+jld ec_conser      ! conversion Ec -> E thermique
1555      DO k = 1, llm      DO k = 1, llm
1556         DO i = 1, klon         DO i = 1, klon
1557            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1558            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1559                 *(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)
1560            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)
1561            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1562         END DO         END DO
1563      END DO      END DO
1564      !-jld ec_conser  
1565      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1566         ztit='after physic'         tit = 'after physic'
1567         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1568              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1569              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1570         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1571         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1572         !     est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1573         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1574         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1575              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1576              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1577    
1578         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1579    
1580      END IF      END IF
1581    
1582      !   SORTIES      ! SORTIES
1583    
1584      !cc prw = eau precipitable      ! prw = eau precipitable
1585      DO i = 1, klon      DO i = 1, klon
1586         prw(i) = 0.         prw(i) = 0.
1587         DO k = 1, llm         DO k = 1, llm
1588            prw(i) = prw(i) + &            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)
                q_seri(i, k)*(paprs(i, k)-paprs(i, k+1))/RG  
1589         ENDDO         ENDDO
1590      ENDDO      ENDDO
1591    
# Line 1949  contains Line 1593  contains
1593    
1594      DO k = 1, llm      DO k = 1, llm
1595         DO i = 1, klon         DO i = 1, klon
1596            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1597            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1598            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1599            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
1600            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
1601         ENDDO         ENDDO
1602      ENDDO      ENDDO
1603    
1604      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1605         DO iq = 3, nq         DO iq = 3, nqmx
1606            DO  k = 1, llm            DO k = 1, llm
1607               DO  i = 1, klon               DO i = 1, klon
1608                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
1609               ENDDO               ENDDO
1610            ENDDO            ENDDO
1611         ENDDO         ENDDO
1612      ENDIF      ENDIF
1613    
1614      ! 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:
   
1615      DO k = 1, llm      DO k = 1, llm
1616         DO i = 1, klon         DO i = 1, klon
1617            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1976  contains Line 1619  contains
1619         ENDDO         ENDDO
1620      ENDDO      ENDDO
1621    
1622      !   Ecriture des sorties      ! Ecriture des sorties
   
     call write_histhf  
     call write_histday  
1623      call write_histins      call write_histins
1624    
1625      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1626      IF (lafin) THEN      IF (lafin) THEN
1627         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1628         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1629              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1630              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1631              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1632              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1633      ENDIF      ENDIF
1634    
1635    contains      firstcal = .FALSE.
   
     subroutine write_histday  
   
       use grid_change, only: gr_phy_write_3d  
1636    
1637        !------------------------------------------------    contains
   
       if (ok_journe) THEN  
          ndex2d = 0  
          ndex3d = 0  
          itau_w = itau_phy + itap  
          call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))  
   
          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  
   
       ndex2d = 0  
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
   
       call write_histhf3d  
   
       IF (ok_sync) THEN  
          call histsync(nid_hf)  
       ENDIF  
   
     end subroutine write_histhf  
   
     !***************************************************************  
1638    
1639      subroutine write_histins      subroutine write_histins
1640    
1641        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1642    
1643          use dimens_m, only: iim, jjm
1644          USE histsync_m, ONLY: histsync
1645          USE histwrite_m, ONLY: histwrite
1646    
1647        real zout        real zout
1648          integer itau_w ! pas de temps ecriture
1649          REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1650    
1651        !--------------------------------------------------        !--------------------------------------------------
1652    
1653        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1654           ! Champs 2D:           ! Champs 2D:
1655    
1656           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1657           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1658           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1659    
1660           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1661           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1662           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1663    
1664           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1665           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1666           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1667    
1668           DO i = 1, klon           DO i = 1, klon
1669              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1670           ENDDO           ENDDO
1671           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1672           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1673    
1674           DO i = 1, klon           DO i = 1, klon
1675              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1676           ENDDO           ENDDO
1677           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1678           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1679    
1680           DO i = 1, klon           DO i = 1, klon
1681              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1682           ENDDO           ENDDO
1683           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1684           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1685    
1686           DO i = 1, klon           DO i = 1, klon
1687              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1688           ENDDO           ENDDO
1689           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1690           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1691    
1692           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1693           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1694           !ccIM           !ccIM
1695           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1696           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1697    
1698           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1699           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1700    
1701           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1702           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1703    
1704           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1705           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1706    
1707           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1708           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1709    
1710           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1711           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1712    
1713           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1714           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1715    
1716           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1717           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1718    
1719           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1720           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1721    
1722           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1723           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1724    
1725           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1726           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1727    
1728           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1729           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1730    
1731           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1732           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1733    
1734           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1735           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1736           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1737           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1738    
1739           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1740           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1741    
1742           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1743           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1744    
1745           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1746           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1747    
1748           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1749           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1750    
1751           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1752           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1753    
1754           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1755              !XXX              !XXX
1756              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1757              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1758              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1759                   zx_tmp_2d)                   zx_tmp_2d)
1760    
1761              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1762              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1763              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1764                   zx_tmp_2d)                   zx_tmp_2d)
1765    
1766              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1767              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1768              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1769                   zx_tmp_2d)                   zx_tmp_2d)
1770    
1771              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1772              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1773              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1774                   zx_tmp_2d)                   zx_tmp_2d)
1775    
1776              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1777              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1778              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1779                   zx_tmp_2d)                   zx_tmp_2d)
1780    
1781              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1782              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1783              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1784                   zx_tmp_2d)                   zx_tmp_2d)
1785    
1786              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1787              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1788              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1789                   zx_tmp_2d)                   zx_tmp_2d)
1790    
1791              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1792              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1793              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1794                   zx_tmp_2d)                   zx_tmp_2d)
1795    
1796              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1797              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1798              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1799                   zx_tmp_2d)                   zx_tmp_2d)
1800    
1801           END DO           END DO
1802           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1803           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1804           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1805           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1806    
1807           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1808           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1809    
          !IM cf. AM 081204 BEG  
   
1810           !HBTM2           !HBTM2
1811    
1812           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1813           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1814    
1815           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1816           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1817    
1818           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1819           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1820    
1821           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
1822           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1823    
1824           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
1825           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1826    
1827           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
1828           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1829    
1830           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
1831           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1832    
1833           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
1834           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1835    
1836           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
1837           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1838    
1839           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
1840           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1841    
          !IM cf. AM 081204 END  
   
1842           ! Champs 3D:           ! Champs 3D:
1843    
1844           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
1845           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1846    
1847           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
1848           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1849    
1850           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
1851           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1852    
1853           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
1854           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1855    
1856           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
1857           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
1858    
1859           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
1860           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
1861    
1862           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1863           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1864    
1865           if (ok_sync) then           call histsync(nid_ins)
             call histsync(nid_ins)  
          endif  
1866        ENDIF        ENDIF
1867    
1868      end subroutine write_histins      end subroutine write_histins
1869    
     !****************************************************  
   
     subroutine write_histhf3d  
   
       ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09  
   
       ndex2d = 0  
       ndex3d = 0  
   
       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  
   
       if (ok_sync) then  
          call histsync(nid_hf3d)  
       endif  
   
     end subroutine write_histhf3d  
   
1870    END SUBROUTINE physiq    END SUBROUTINE physiq
1871    
   !****************************************************  
   
   FUNCTION qcheck(klon, klev, paprs, q, ql, aire)  
   
     ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28  
   
     use YOMCST  
     IMPLICIT none  
   
     ! Calculer et imprimer l'eau totale. A utiliser pour verifier  
     ! la conservation de l'eau  
   
     INTEGER klon, klev  
     REAL, intent(in):: paprs(klon, klev+1)  
     real q(klon, klev), ql(klon, klev)  
     REAL aire(klon)  
     REAL qtotal, zx, qcheck  
     INTEGER i, k  
   
     zx = 0.0  
     DO i = 1, klon  
        zx = zx + aire(i)  
     ENDDO  
     qtotal = 0.0  
     DO k = 1, klev  
        DO i = 1, klon  
           qtotal = qtotal + (q(i, k)+ql(i, k)) * aire(i) &  
                *(paprs(i, k)-paprs(i, k+1))/RG  
        ENDDO  
     ENDDO  
   
     qcheck = qtotal/zx  
   
   END FUNCTION qcheck  
   
1872  end module physiq_m  end module physiq_m

Legend:
Removed from v.16  
changed lines
  Added in v.91

  ViewVC Help
Powered by ViewVC 1.1.21