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

Diff of /trunk/phylmd/physiq.f

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

revision 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC
# Line 1  Line 1 
1  module physiq_m  module physiq_m
2    
   ! This module is clean: no C preprocessor directive, no include line.  
   
3    IMPLICIT none    IMPLICIT none
4    
   private  
   public physiq  
   
5  contains  contains
6    
7    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)
9         d_t, d_qx, d_ps, dudyn, PVteta)  
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)
11      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! Author: Z.X. Li (LMD/CNRS) 1993
12    
13      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! This is the main procedure for the "physics" part of the program.
14    
15      ! Objet: Moniteur general de la physique du modele      USE abort_gcm_m, ONLY: abort_gcm
16      !AA      Modifications quant aux traceurs :      USE calendar, ONLY: ymds2ju
17      !AA                  -  uniformisation des parametrisations ds phytrac      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
18      !AA                  -  stockage des moyennes des champs necessaires           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
19      !AA                     en mode traceur off-line      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
20             ok_orodr, ok_orolf, soil_model
21      USE ioipsl, only: ymds2ju, histwrite, histsync      USE clmain_m, ONLY: clmain
22      use dimens_m, only: jjm, iim, llm      USE comgeomphy, ONLY: airephy, cuphy, cvphy
23      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      USE concvl_m, ONLY: concvl
24           clnsurf, epsfra      USE conf_gcm_m, ONLY: offline, raz_date
25      use dimphy, only: klon, nbtr      USE conf_phys_m, ONLY: conf_phys
26      use conf_gcm_m, only: raz_date, offline, iphysiq      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
27      use dimsoil, only: nsoilmx      use diagetpq_m, only: diagetpq
28      use temps, only: itau_phy, day_ref, annee_ref, itaufin      USE dimens_m, ONLY: iim, jjm, llm, nqmx
29      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      USE dimphy, ONLY: klon, nbtr
30           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &      USE dimsoil, ONLY: nsoilmx
31           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
32           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &      USE hgardfou_m, ONLY: hgardfou
33           ok_kzmin, soil_model      USE histcom, ONLY: histsync
34      use iniprint, only: lunout, prt_level      USE histwrite_m, ONLY: histwrite
35      use abort_gcm_m, only: abort_gcm      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
36      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega           nbsrf
37      use comgeomphy      USE ini_histhf_m, ONLY: ini_histhf
38      use ctherm      USE ini_histday_m, ONLY: ini_histday
39      use phytrac_m, only: phytrac      USE ini_histins_m, ONLY: ini_histins
40      use oasis_m      USE oasis_m, ONLY: ok_oasis
41      use radepsi      USE orbite_m, ONLY: orbite, zenang
42      use radopt      USE ozonecm_m, ONLY: ozonecm
43      use yoethf      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
44      use ini_hist, only: ini_histhf, ini_histday, ini_histins      USE phyredem_m, ONLY: phyredem
45      use orbite_m, only: orbite, zenang      USE phystokenc_m, ONLY: phystokenc
46      use phyetat0_m, only: phyetat0, rlat, rlon      USE phytrac_m, ONLY: phytrac
47      use hgardfou_m, only: hgardfou      USE qcheck_m, ONLY: qcheck
48      use conf_phys_m, only: conf_phys      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
49        USE temps, ONLY: annee_ref, day_ref, itau_phy
50      ! Declaration des constantes et des fonctions thermodynamiques :      USE yoethf_m, ONLY: r2es, rvtmp2
51      use fcttre, only: thermcep, foeew, qsats, qsatl  
52        ! Arguments:
53      ! Variables argument:  
54        REAL, intent(in):: rdayvrai
55      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      ! (elapsed time since January 1st 0h of the starting year, in days)
56      REAL rjourvrai ! input numero du jour de l'experience  
57      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journée en fraction de jour
58      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: debut ! premier passage  
59      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
60    
61      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
62      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
63        
64      REAL pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
65      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
66    
67      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
68      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
69    
70      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
71    
72        REAL, intent(in):: u(klon, llm)
73        ! vitesse dans la direction X (de O a E) en m/s
74    
75      REAL presnivs(llm)      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
76      ! (input pressions approximat. des milieux couches ( en PA))      REAL, intent(in):: t(klon, llm) ! input temperature (K)
77    
78      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: qx(klon, llm, nqmx)
79      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      ! (humidité spécifique et fractions massiques des autres traceurs)
80      REAL t(klon, llm)  ! input temperature (K)  
81        REAL omega(klon, llm) ! input vitesse verticale en Pa/s
82      REAL qx(klon, llm, nq)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
83      ! (input humidite specifique (kg/kg) et d'autres traceurs)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
84        REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
85      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
86      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_ps(klon) ! output tendance physique de la pression au sol
87      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
88      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      LOGICAL:: firstcal = .true.
     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      INTEGER nbteta
91      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
92    
93      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
94      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
95    
96      LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
97      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
98      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
99      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
100    
101      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
102      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
103      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
104      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
105        ! Ajouter artificiellement les stratus
106    
107      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
108      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
109      logical rnpb      logical rnpb
110      parameter(rnpb=.true.)      parameter(rnpb = .true.)
111      !      ocean = type de modele ocean a utiliser: force, slab, couple  
112      character(len=6) ocean      character(len = 6), save:: ocean
113      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
114    
115      logical ok_ocean      logical ok_ocean
116      SAVE ok_ocean      SAVE ok_ocean
117    
118      !IM "slab" ocean      ! "slab" ocean
119      REAL tslab(klon)    !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
120      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
121      REAL seaice(klon)   !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
122      SAVE seaice      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxo(klon)    !flux turbulents ocean-glace de mer  
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
123    
124      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
125      logical ok_veget      logical, save:: ok_veget
126      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
127    
128      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
129    
# Line 139  contains Line 131  contains
131      save ok_instan      save ok_instan
132    
133      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
134      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
135    
136      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
137      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
138      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
139      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
140      save q2  
141        INTEGER ivap ! indice de traceurs pour vapeur d'eau
142        PARAMETER (ivap = 1)
143        INTEGER iliq ! indice de traceurs pour eau liquide
144        PARAMETER (iliq = 2)
145    
146      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
147      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  
148    
149      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
150      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)
151    
152      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
153    
154      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
155    
156      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
157      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
158      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
159      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 172  contains Line 161  contains
161      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
162    
163      INTEGER klevp1      INTEGER klevp1
164      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
165    
166      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
167      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
168      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
169    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
170      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
171      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
172      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
173    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
174      !IM Amip2      !IM Amip2
175      ! variables a une pression donnee      ! variables a une pression donnee
176    
177      integer nlevSTD      integer nlevSTD
178      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
179      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
180      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
181           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
182           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
183      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
184      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
185           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
186           '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  
187    
188      ! prw: precipitable water      ! prw: precipitable water
189      real prw(klon)      real prw(klon)
# Line 263  contains Line 193  contains
193      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
194      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
195    
196      INTEGER l, kmax, lmax      INTEGER kmax, lmax
197      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
198      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
199      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
200    
201      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
202      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
# Line 277  contains Line 207  contains
207      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
208    
209      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
210      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
211    
212      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
213      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
214      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
215    
216      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
217      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', &
218           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
219           '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 245  contains
245      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
246      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
247    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
   
248      ! Variables propres a la physique      ! Variables propres a la physique
249    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
250      INTEGER, save:: radpas      INTEGER, save:: radpas
251      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
252      ! "physiq".)      ! "physiq".)
253    
254      REAL radsol(klon)      REAL radsol(klon)
255      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
256    
257      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
258    
259      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
260    
261      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
262      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
263    
264      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
265      SAVE fevap                 ! 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
   
     !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):  
   
     REAL zmea(klon)  
     SAVE zmea                   ! orographie moyenne  
   
     REAL zstd(klon)  
     SAVE zstd                   ! deviation standard de l'OESM  
   
     REAL zsig(klon)  
     SAVE zsig                   ! pente de l'OESM  
   
     REAL zgam(klon)  
     save zgam                   ! anisotropie de l'OESM  
   
     REAL zthe(klon)  
     SAVE zthe                   ! orientation de l'OESM  
281    
282      REAL zpic(klon)      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
283      SAVE zpic                   ! Maximum de l'OESM      REAL, save:: zmea(klon) ! orographie moyenne
284        REAL, save:: zstd(klon) ! deviation standard de l'OESM
285      REAL zval(klon)      REAL, save:: zsig(klon) ! pente de l'OESM
286      SAVE zval                   ! Minimum de l'OESM      REAL, save:: zgam(klon) ! anisotropie de l'OESM
287        REAL, save:: zthe(klon) ! orientation de l'OESM
288      REAL rugoro(klon)      REAL, save:: zpic(klon) ! Maximum de l'OESM
289      SAVE rugoro                 ! longueur de rugosite de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
290        REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
291    
292      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
293    
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 ema_work1(klon, llm), ema_work2(klon, llm)
313      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
314    
315      REAL wd(klon) ! sb      REAL wd(klon) ! sb
316      SAVE wd       ! sb      SAVE wd ! sb
317    
318      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
319    
# Line 423  contains Line 322  contains
322      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
323      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
324    
325      !AA  Pour phytrac      !AA Pour phytrac
326      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
327      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
328      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
329      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
330      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
331      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
332      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
333      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
334    
335      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 449  contains Line 348  contains
348      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
349      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
350    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
351      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
352      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
353      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
354      SAVE dlw      SAVE dlw
355      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
356      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 472  contains Line 368  contains
368    
369      INTEGER julien      INTEGER julien
370    
371      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
372      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
373      !IM      !IM
374      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
375    
376      SAVE pctsrf                 ! sous-fraction du sol      SAVE pctsrf ! sous-fraction du sol
377      REAL albsol(klon)      REAL albsol(klon)
378      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
379      REAL albsollw(klon)      REAL albsollw(klon)
380      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
381    
382      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
383    
384      ! Declaration des procedures appelees      ! Declaration des procedures appelees
385    
386      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
387      EXTERNAL ajsec     ! ajustement sec      EXTERNAL ajsec ! ajustement sec
     EXTERNAL clmain    ! couche limite  
388      !KE43      !KE43
389      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
390      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
391      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
392      EXTERNAL ozonecm   ! prescrire l'ozone      EXTERNAL radlwsw ! rayonnements solaire et infrarouge
393      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
   
     EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression  
     EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression  
394    
395      ! Variables locales      ! Variables locales
396    
# Line 509  contains Line 399  contains
399    
400      save rnebcon, clwcon      save rnebcon, clwcon
401    
402      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
403      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
404      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
405      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
406      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
407      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
408      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
409    
410      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
411      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
412      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
413      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
414    
415      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
416      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
417      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
418      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
419    
420      REAL heat(klon, llm)    ! chauffage solaire      REAL heat(klon, llm) ! chauffage solaire
421      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
422      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL cool(klon, llm) ! refroidissement infrarouge
423      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
424      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
425      real sollwdown(klon)    ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
426      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
427      REAL albpla(klon)      REAL albpla(klon)
428      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
429      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
430      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      ! Le rayonnement n'est pas calcule tous les pas, il faut donc
431      !                      sauvegarder les sorties du rayonnement      ! sauvegarder les sorties du rayonnement
432      SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown      SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown
433      SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0
434    
435      INTEGER itaprad      INTEGER itaprad
436      SAVE itaprad      SAVE itaprad
437    
438      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
439      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
440    
441      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
442      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 561  contains Line 451  contains
451      LOGICAL zx_ajustq      LOGICAL zx_ajustq
452    
453      REAL za, zb      REAL za, zb
454      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
455      real zqsat(klon, llm)      real zqsat(klon, llm)
456      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
457      REAL t_coup      REAL t_coup
458      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
459    
460      REAL zphi(klon, llm)      REAL zphi(klon, llm)
461    
462      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
463    
464      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
465      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
466      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
467      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
468      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
469      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
470      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
471      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
472      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
473      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
474      ! Grdeurs de sorties      ! Grdeurs de sorties
475      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
476      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 589  contains Line 479  contains
479    
480      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel (sb):
481    
482      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
483      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
484      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
485      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
486      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
487      SAVE cape      SAVE cape
488    
489      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
490      SAVE pbase      SAVE pbase
491      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
492      SAVE bbase      SAVE bbase
493      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
494      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
495      ! -- convect43:      ! -- convect43:
496      INTEGER ntra              ! nb traceurs pour convect4.3      INTEGER ntra ! nb traceurs pour convect4.3
497      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
498      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
499    
500      ! Variables du changement      ! Variables du changement
501    
502      ! con: convection      ! con: convection
503      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
504      ! ajs: ajustement sec      ! ajs: ajustement sec
505      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
506      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
507      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
508      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
509      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 625  contains Line 515  contains
515      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
516      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
517      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
518      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
519      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)  
520    
521      SAVE ibas_con, itop_con      INTEGER,save:: ibas_con(klon), itop_con(klon)
522    
523      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
524      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 649  contains Line 537  contains
537      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
538    
539      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
540      real fact_cldcon      real, save:: fact_cldcon
541      real facttemps      real, save:: facttemps
542      logical ok_newmicro      logical ok_newmicro
543      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
544      real facteur      real facteur
545    
546      integer iflag_cldcon      integer iflag_cldcon
# Line 661  contains Line 548  contains
548    
549      logical ptconv(klon, llm)      logical ptconv(klon, llm)
550    
551      ! Variables liees a l'ecriture de la bande histoire physique      ! Variables locales pour effectuer les appels en série :
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
     ! Variables locales pour effectuer les appels en serie  
552    
553      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
554      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 676  contains Line 559  contains
559    
560      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
561    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
562      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
563      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
564      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
565      REAL aam, torsfc      REAL aam, torsfc
566    
567      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
   
     REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique  
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
568    
569        REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
570      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
571    
572      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
573    
574      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
575      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 704  contains Line 578  contains
578    
579      REAL zsto      REAL zsto
580    
581      character(len=20) modname      character(len = 20) modname
582      character(len=80) abort_message      character(len = 80) abort_message
583      logical ok_sync      logical ok_sync
584      real date0      real date0
585    
586      !     Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
587      REAL ztsol(klon)      REAL ztsol(klon)
588      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
589      REAL      d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
590      REAL      fs_bound, fq_bound      REAL fs_bound, fq_bound
591      SAVE      d_h_vcol_phy      REAL zero_v(klon)
592      REAL      zero_v(klon)      CHARACTER(LEN = 15) ztit
593      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
594      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
595      SAVE      ip_ebil  
596      DATA      ip_ebil/0/      REAL d_t_ec(klon, llm) ! tendance due à 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  
597      REAL ZRCPD      REAL ZRCPD
598      !-jld ec_conser  
599      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m  
600      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
601      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
602      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
603      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
604      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
605    
606      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
607      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
608    
609      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
610      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
611    
612      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
613      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
614    
615      ! Aerosol optical properties      ! Aerosol optical properties
616      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
617      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
618    
619      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
620      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
621    
622      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
623      ! ok_aie=T ->      ! ok_aie = True ->
624      !        ok_ade=T -AIE=topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
625      !        ok_ade=F -AIE=topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
626    
627      REAL aerindex(klon)       ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
628    
629      ! Parameters      ! Parameters
630      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
631      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
632    
633      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1
634      SAVE u10m      SAVE u10m
# Line 782  contains Line 650  contains
650      SAVE d_v_con      SAVE d_v_con
651      SAVE rnebcon0      SAVE rnebcon0
652      SAVE clwcon0      SAVE clwcon0
653      SAVE pblh  
654      SAVE plcl      real zmasse(klon, llm)
655      SAVE capCL      ! (column-density of mass of air in a cell, in kg m-2)
656      SAVE oliqCL  
657      SAVE cteiCL      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
658    
659      !----------------------------------------------------------------      !----------------------------------------------------------------
660    
661      modname = 'physiq'      modname = 'physiq'
662      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
663         DO i=1, klon         DO i = 1, klon
664            zero_v(i)=0.            zero_v(i) = 0.
665         END DO         END DO
666      END IF      END IF
667      ok_sync=.TRUE.      ok_sync = .TRUE.
668      IF (nq .LT. 2) THEN      IF (nqmx < 2) THEN
669         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
670         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
671      ENDIF      ENDIF
672    
673      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
674           ! initialiser
675      test_debut: IF (debut) THEN         u10m = 0.
676         !  initialiser         v10m = 0.
677         u10m(:, :)=0.         t2m = 0.
678         v10m(:, :)=0.         q2m = 0.
679         t2m(:, :)=0.         ffonte = 0.
680         q2m(:, :)=0.         fqcalving = 0.
681         ffonte(:, :)=0.         piz_ae = 0.
682         fqcalving(:, :)=0.         tau_ae = 0.
683         piz_ae(:, :, :)=0.         cg_ae = 0.
684         tau_ae(:, :, :)=0.         rain_con(:) = 0.
685         cg_ae(:, :, :)=0.         snow_con(:) = 0.
686         rain_con(:)=0.         bl95_b0 = 0.
687         snow_con(:)=0.         bl95_b1 = 0.
688         bl95_b0=0.         topswai(:) = 0.
689         bl95_b1=0.         topswad(:) = 0.
690         topswai(:)=0.         solswai(:) = 0.
691         topswad(:)=0.         solswad(:) = 0.
692         solswai(:)=0.  
693         solswad(:)=0.         d_u_con = 0.0
694           d_v_con = 0.0
695         d_u_con(:, :) = 0.0         rnebcon0 = 0.0
696         d_v_con(:, :) = 0.0         clwcon0 = 0.0
697         rnebcon0(:, :) = 0.0         rnebcon = 0.0
698         clwcon0(:, :) = 0.0         clwcon = 0.0
699         rnebcon(:, :) = 0.0  
700         clwcon(:, :) = 0.0         pblh =0. ! Hauteur de couche limite
701           plcl =0. ! Niveau de condensation de la CLA
702         pblh(:, :)   =0.        ! Hauteur de couche limite         capCL =0. ! CAPE de couche limite
703         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         oliqCL =0. ! eau_liqu integree de couche limite
704         capCL(:, :)  =0.        ! CAPE de couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
705         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         pblt =0. ! T a la Hauteur de couche limite
706         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         therm =0.
707         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         trmb1 =0. ! deep_cape
708         therm(:, :)  =0.         trmb2 =0. ! inhibition
709         trmb1(:, :)  =0.        ! deep_cape         trmb3 =0. ! Point Omega
        trmb2(:, :)  =0.        ! inhibition  
        trmb3(:, :)  =0.        ! Point Omega  
710    
711         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
712    
713         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
714    
715         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &
716              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ok_instan, fact_cldcon, facttemps, ok_newmicro, &
717              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
718              ok_ade, ok_aie,  &              ok_ade, ok_aie, &
719              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
720              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
721    
# Line 863  contains Line 724  contains
724         frugs = 0.         frugs = 0.
725         itap = 0         itap = 0
726         itaprad = 0         itaprad = 0
727         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
728              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
729              ocean, tslab, seaice, & !IM "slab" ocean              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
730              fqsurf, qsol, fsnow, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
731              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             dlw, radsol, frugs, agesno, clesphy0, &  
             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &  
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
732    
733         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
734         q2(:, :, :)=1.e-8         q2 = 1.e-8
735    
736         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
737    
738         ! on remet le calendrier a zero         ! on remet le calendrier a zero
739           IF (raz_date) itau_phy = 0
740    
741         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
742    
743         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
744            ok_ocean=.TRUE.            ok_ocean = .TRUE.
745         ENDIF         ENDIF
746    
747         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
748              ok_instan, ok_region )              ok_region)
749    
750         IF (ABS(dtime-pdtphys).GT.0.001) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
751            WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &            print *,'Nbre d appels au rayonnement insuffisant'
752                 pdtphys            print *,"Au minimum 4 appels par jour si cycle diurne"
753            abort_message='Pas physique n est pas correct '            abort_message = 'Nbre d appels au rayonnement insuffisant'
754            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
755         ENDIF         ENDIF
756           print *,"Clef pour la convection, iflag_con = ", iflag_con
757         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         print *,"Clef pour le driver de la convection, ok_cvl = ", &
           WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'  
           WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"  
           abort_message='Nbre d appels au rayonnement insuffisant'  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
        WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con  
        WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &  
758              ok_cvl              ok_cvl
759    
760         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
761         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
762    
763            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3 "
764    
765            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
766            DO i = 1, klon            DO i = 1, klon
# Line 925  contains Line 772  contains
772         ENDIF         ENDIF
773    
774         IF (ok_orodr) THEN         IF (ok_orodr) THEN
775            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
776               rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)            CALL SUGWD(klon, llm, paprs, play)
777            ENDDO         else
778            CALL SUGWD(klon, llm, paprs, pplay)            rugoro = 0.
779         ENDIF         ENDIF
780    
781         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
782         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
783    
784         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/dtphys)
785         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/dtphys)
786         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/dtphys)
787         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
788         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/dtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
789    
790         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
791    
792         npas = 0         npas = 0
793         nexca = 0         nexca = 0
        if (ocean == 'couple') then  
           npas = itaufin/ iphysiq  
           nexca = 86400 / int(dtime)  
           write(lunout, *)' Ocean couple'  
           write(lunout, *)' Valeurs des pas de temps'  
           write(lunout, *)' npas = ', npas  
           write(lunout, *)' nexca = ', nexca  
        endif  
794    
795         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
796    
797         !   Initialisation des sorties         ! Initialisation des sorties
798    
799         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
800         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
801         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
802         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
803         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
804         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
805      ENDIF test_debut      ENDIF test_firstcal
806    
807      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
808    
809      DO i = 1, klon      DO i = 1, klon
810         d_ps(i) = 0.0         d_ps(i) = 0.0
811      ENDDO      ENDDO
812      DO k = 1, llm      DO iq = 1, nqmx
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
     DO iq = 1, nq  
813         DO k = 1, llm         DO k = 1, llm
814            DO i = 1, klon            DO i = 1, klon
815               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
816            ENDDO            ENDDO
817         ENDDO         ENDDO
818      ENDDO      ENDDO
819      da(:, :)=0.      da = 0.
820      mp(:, :)=0.      mp = 0.
821      phi(:, :, :)=0.      phi = 0.
822    
823      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrées de u, v, h, et q :
824    
825      DO k = 1, llm      DO k = 1, llm
826         DO i = 1, klon         DO i = 1, klon
827            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
828            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
829            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
830            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
831            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
832            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
833         ENDDO         ENDDO
834      ENDDO      ENDDO
835      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
836         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
837      ELSE      ELSE
838         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
839      ENDIF      ENDIF
# Line 1017  contains Line 848  contains
848      ENDDO      ENDDO
849    
850      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
851         ztit='after dynamic'         ztit = 'after dynamics'
852         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
853              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
854              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
855         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
856         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
857         !     est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
858         !     Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
859         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
860              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
861              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
862              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
863      END IF      END IF
864    
865      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
866      IF (ancien_ok) THEN      IF (ancien_ok) THEN
867         DO k = 1, llm         DO k = 1, llm
868            DO i = 1, klon            DO i = 1, klon
869               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtime               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
870               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtime               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
871            ENDDO            ENDDO
872         ENDDO         ENDDO
873      ELSE      ELSE
# Line 1052  contains Line 881  contains
881      ENDIF      ENDIF
882    
883      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
884      DO k = 1, llm      DO k = 1, llm
885         DO i = 1, klon         DO i = 1, klon
886            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
887         ENDDO         ENDDO
888      ENDDO      ENDDO
889    
890      ! Verifier les temperatures      ! Check temperatures:
   
891      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
892    
893      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
894        itap = itap + 1
895      itap   = itap + 1      julien = MOD(NINT(rdayvrai), 360)
     julien = MOD(NINT(xjour), 360)  
896      if (julien == 0) julien = 360      if (julien == 0) julien = 360
897    
898        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
899    
900      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
901    
902      IF (MOD(itap - 1, lmt_pas) == 0) THEN      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
903         CALL ozonecm(REAL(julien), rlat, paprs, wo)      if (nqmx >= 5) then
904           wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
905        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
906           wo = ozonecm(REAL(julien), paprs)
907      ENDIF      ENDIF
908    
909      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
910        DO k = 1, llm
     DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse  
911         DO i = 1, klon         DO i = 1, klon
912            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
913            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
914            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  
915            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
916         ENDDO         ENDDO
917      ENDDO      ENDDO
918        ql_seri = 0.
919    
920      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
921         ztit='after reevap'         ztit = 'after reevap'
922         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
923              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
924              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
925         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
926              , 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, &
927              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
928    
929      END IF      END IF
930    
# Line 1125  contains Line 948  contains
948    
949      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
950      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
951         zdtime = dtime * REAL(radpas)         zdtime = dtphys * REAL(radpas)
952         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
953      ELSE      ELSE
954         rmu0 = -999.999         rmu0 = -999.999
955      ENDIF      ENDIF
956    
957      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
958      albsol(:)=0.      albsol(:) = 0.
959      albsollw(:)=0.      albsollw(:) = 0.
960      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
961         DO i = 1, klon         DO i = 1, klon
962            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1141  contains Line 964  contains
964         ENDDO         ENDDO
965      ENDDO      ENDDO
966    
967      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
968      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
969    
970      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1154  contains Line 977  contains
977    
978      fder = dlw      fder = dlw
979    
980      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
981           t_seri, q_seri, u_seri, v_seri, &  
982           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
983           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
984           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
985           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
986           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
987           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
988           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
989           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
990           debut, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
991           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
992           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
993           q2, dsens, devap, &      ! Incrémentation des flux
994           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
995           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
996           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
997           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
998           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
999      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1000         DO k = 1, llm         DO k = 1, llm
1001            DO i = 1, klon            DO i = 1, klon
1002               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
1003                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1004               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
1005                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1006               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
1007                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1008               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1009                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1010            END DO            END DO
1011         END DO         END DO
1012      END DO      END DO
# Line 1210  contains Line 1026  contains
1026      ENDDO      ENDDO
1027    
1028      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1029         ztit='after clmain'         ztit = 'after clmain'
1030         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1031              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1032              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1033         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1034              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1035              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1036      END IF      END IF
1037    
1038      ! Incrementer la temperature du sol      ! Update surface temperature:
1039    
1040      DO i = 1, klon      DO i = 1, klon
1041         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1245  contains Line 1059  contains
1059         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1060         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1061    
1062         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1063              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1064              THEN              THEN
1065            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1066                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1067         ENDIF         ENDIF
1068      ENDDO      ENDDO
# Line 1263  contains Line 1077  contains
1077            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1078            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1079            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1080            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1081                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1082            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1083            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 1282  contains Line 1096  contains
1096    
1097      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1098         DO i = 1, klon         DO i = 1, klon
1099            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1100    
1101            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1102            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1103            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1104            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1105            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1106            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1107                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1108            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1109            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1110            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1111            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1112            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1113            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1114            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1115            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1116            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1117            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1118         ENDDO         ENDDO
1119      ENDDO      ENDDO
1120    
# Line 1314  contains Line 1128  contains
1128    
1129      DO k = 1, llm      DO k = 1, llm
1130         DO i = 1, klon         DO i = 1, klon
1131            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1132                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/dtphys
1133            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1134                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/dtphys
1135         ENDDO         ENDDO
1136      ENDDO      ENDDO
1137      IF (check) THEN      IF (check) THEN
1138         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1139         WRITE(lunout, *) "avantcon=", za         print *, "avantcon = ", za
1140      ENDIF      ENDIF
1141      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1142      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1143      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1144         DO i = 1, klon         DO i = 1, klon
1145            z_avant(i) = 0.0            z_avant(i) = 0.0
1146         ENDDO         ENDDO
1147         DO k = 1, llm         DO k = 1, llm
1148            DO i = 1, klon            DO i = 1, klon
1149               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &
1150                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1151            ENDDO            ENDDO
1152         ENDDO         ENDDO
1153      ENDIF      ENDIF
1154      IF (iflag_con == 1) THEN  
1155         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1156      ELSE IF (iflag_con == 2) THEN      case (1)
1157         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1158              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1159              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1160              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1161              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1162                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1163                pmflxs)
1164         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1165         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1166         DO i = 1, klon         DO i = 1, klon
1167            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1168            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1169         ENDDO         ENDDO
1170      ELSE IF (iflag_con >= 3) THEN      case (3:)
1171         ! nb of tracers for the KE convection:         ! number of tracers for the Kerry-Emanuel convection:
1172         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1173         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1174         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1175         ntra = 1         ntra = 1
1176         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1177         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1178    
1179         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1180              ! new driver for convectL
1181            CALL concvl (iflag_con, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1182                 dtime, paprs, pplay, t_seri, q_seri, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1183                 u_seri, v_seri, tr_seri, ntra, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1184                 ema_work1, ema_work2, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1185                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1186                 rain_con, snow_con, ibas_con, itop_con, &                 pmflxs, da, phi, mp)
1187                 upwd, dnwd, dnwd0, &            clwcon0 = qcondc
1188                 Ma, cape, tvp, iflagctrl, &            pmfu = upwd + dnwd
1189                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &         ELSE
1190                 pmflxr, pmflxs, &            ! conema3 ne contient pas les traceurs
1191                 da, phi, mp)            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1192                   tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1193            clwcon0=qcondc                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1194            pmfu(:, :)=upwd(:, :)+dnwd(:, :)                 itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &
1195                   pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1196         ELSE ! ok_cvl         ENDIF
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (dtime, &  
                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  
1197    
1198         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1199            do i = 1, klon            do i = 1, klon
1200               wd(i)=0.0               wd(i) = 0.0
1201            enddo            enddo
1202         ENDIF         ENDIF
1203    
1204         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1205    
1206         DO k = 1, llm         DO k = 1, llm
1207            DO i = 1, klon            DO i = 1, klon
1208               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1209               IF (thermcep) THEN               IF (thermcep) THEN
1210                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1211                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1212                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1213                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1214                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1215               ELSE               ELSE
1216                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1217                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1218                  ELSE                  ELSE
1219                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1220                  ENDIF                  ENDIF
1221               ENDIF               ENDIF
1222               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1223            ENDDO            ENDDO
1224         ENDDO         ENDDO
1225    
1226         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1227         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0 = fact_cldcon*clwcon0
1228         call clouds_gno &         call clouds_gno &
1229              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1230      ELSE      case default
1231         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1232         stop 1         stop 1
1233      ENDIF      END select
1234    
1235      DO k = 1, llm      DO k = 1, llm
1236         DO i = 1, klon         DO i = 1, klon
# Line 1440  contains Line 1242  contains
1242      ENDDO      ENDDO
1243    
1244      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1245         ztit='after convect'         ztit = 'after convect'
1246         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1247              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1248              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1249         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1250              , 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, &
1251              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1252      END IF      END IF
1253    
1254      IF (check) THEN      IF (check) THEN
1255         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1256         WRITE(lunout, *)"aprescon=", za         print *,"aprescon = ", za
1257         zx_t = 0.0         zx_t = 0.0
1258         za = 0.0         za = 0.0
1259         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1261  contains
1261            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1262                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1263         ENDDO         ENDDO
1264         zx_t = zx_t/za*dtime         zx_t = zx_t/za*dtphys
1265         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip = ", zx_t
1266      ENDIF      ENDIF
1267      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1268         DO i = 1, klon         DO i = 1, klon
# Line 1470  contains Line 1270  contains
1270         ENDDO         ENDDO
1271         DO k = 1, llm         DO k = 1, llm
1272            DO i = 1, klon            DO i = 1, klon
1273               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &
1274                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1275            ENDDO            ENDDO
1276         ENDDO         ENDDO
1277         DO i = 1, klon         DO i = 1, klon
1278            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1279                 /z_apres(i)                 /z_apres(i)
1280         ENDDO         ENDDO
1281         DO k = 1, llm         DO k = 1, llm
1282            DO i = 1, klon            DO i = 1, klon
1283               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > (1.0 + 1.0E-08) .OR. &
1284                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1285                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1286               ENDIF               ENDIF
1287            ENDDO            ENDDO
1288         ENDDO         ENDDO
1289      ENDIF      ENDIF
1290      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1291    
1292      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1293    
1294      d_t_ajs(:, :)=0.      d_t_ajs = 0.
1295      d_u_ajs(:, :)=0.      d_u_ajs = 0.
1296      d_v_ajs(:, :)=0.      d_v_ajs = 0.
1297      d_q_ajs(:, :)=0.      d_q_ajs = 0.
1298      fm_therm(:, :)=0.      fm_therm = 0.
1299      entr_therm(:, :)=0.      entr_therm = 0.
1300    
1301      IF(prt_level>9)WRITE(lunout, *) &      if (iflag_thermals == 0) then
1302           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1303           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
1304      if(iflag_thermals.lt.0) then         t_seri = t_seri + d_t_ajs
1305         !  Rien         q_seri = q_seri + d_q_ajs
        IF(prt_level>9)WRITE(lunout, *)'pas de convection'  
     else if(iflag_thermals == 0) then  
        !  Ajustement sec  
        IF(prt_level>9)WRITE(lunout, *)'ajsec'  
        CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)  
        t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)  
        q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)  
1306      else      else
1307         !  Thermiques         ! Thermiques
1308         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1309              , 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)  
1310      endif      endif
1311    
1312      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1313         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1314         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1315              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1316              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1317      END IF      END IF
1318    
1319      !  Caclul des ratqs      ! Caclul des ratqs
1320    
1321      !   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
1322      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1323      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1324         do k=1, llm         do k = 1, llm
1325            do i=1, klon            do i = 1, klon
1326               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1327                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1328                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1329               else               else
1330                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1331               endif               endif
1332            enddo            enddo
1333         enddo         enddo
1334      endif      endif
1335    
1336      !   ratqs stables      ! ratqs stables
1337      do k=1, llm      do k = 1, llm
1338         do i=1, klon         do i = 1, klon
1339            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1340                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1341         enddo         enddo
1342      enddo      enddo
1343    
1344      !  ratqs final      ! ratqs final
1345      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1346         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1347         !   ratqs final         ! ratqs final
1348         !   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
1349         !   relaxation des ratqs         ! relaxation des ratqs
1350         facteur=exp(-pdtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1351         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs = max(ratqs*facteur, ratqss)
1352         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs = max(ratqs, ratqsc)
1353      else      else
1354         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1355         ratqs(:, :)=ratqss(:, :)         ratqs = ratqss
1356      endif      endif
1357    
1358      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1359      ! et le processus de precipitation      ! précipitation :
1360      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1361           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1362           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1363           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1364    
1365      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1366      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1590  contains Line 1375  contains
1375      ENDDO      ENDDO
1376      IF (check) THEN      IF (check) THEN
1377         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1378         WRITE(lunout, *)"apresilp=", za         print *,"apresilp = ", za
1379         zx_t = 0.0         zx_t = 0.0
1380         za = 0.0         za = 0.0
1381         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1383  contains
1383            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1384                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1385         ENDDO         ENDDO
1386         zx_t = zx_t/za*dtime         zx_t = zx_t/za*dtphys
1387         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip = ", zx_t
1388      ENDIF      ENDIF
1389    
1390      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1391         ztit='after fisrt'         ztit = 'after fisrt'
1392         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1393              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1394              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1395         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1396              , 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, &
1397              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1398      END IF      END IF
1399    
1400      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1401    
1402      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1403    
1404      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1405         snow_tiedtke=0.         snow_tiedtke = 0.
1406         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1407            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1408         else         else
1409            rain_tiedtke=0.            rain_tiedtke = 0.
1410            do k=1, llm            do k = 1, llm
1411               do i=1, klon               do i = 1, klon
1412                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1413                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1414                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1415                  endif                  endif
1416               enddo               enddo
1417            enddo            enddo
1418         endif         endif
1419    
1420         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1421         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1422              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1423              diafra, dialiq)              diafra, dialiq)
1424         DO k = 1, llm         DO k = 1, llm
1425            DO i = 1, klon            DO i = 1, klon
1426               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1427                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1428                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1429               ENDIF               ENDIF
1430            ENDDO            ENDDO
1431         ENDDO         ENDDO
   
1432      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1433         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1434         !  convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1435         !  facttemps         ! facttemps
1436         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1437         do k=1, llm         do k = 1, llm
1438            do i=1, klon            do i = 1, klon
1439               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1440               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1441                    then                    then
1442                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1443                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1444               endif               endif
1445            enddo            enddo
1446         enddo         enddo
1447    
1448         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1449         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1450         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq = cldliq + rnebcon*clwcon
   
1451      ENDIF      ENDIF
1452    
1453      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1454    
1455      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1456         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1457         DO k = 1, llm         DO k = 1, llm
1458            DO i = 1, klon            DO i = 1, klon
1459               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1460                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1461                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1462               ENDIF               ENDIF
# Line 1691  contains Line 1472  contains
1472      ENDDO      ENDDO
1473    
1474      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1475         ztit="after diagcld"         ztit = "after diagcld"
1476         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1477              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1478              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1479      END IF      END IF
1480    
1481      ! Calculer l'humidite relative pour diagnostique      ! Calculer l'humidite relative pour diagnostique
# Line 1704  contains Line 1485  contains
1485            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1486            IF (thermcep) THEN            IF (thermcep) THEN
1487               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1488               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1489               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1490               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1491               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1492            ELSE            ELSE
1493               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1494                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1495               ELSE               ELSE
1496                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1497               ENDIF               ENDIF
1498            ENDIF            ENDIF
1499            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1500            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1501         ENDDO         ENDDO
1502      ENDDO      ENDDO
1503      !jq - introduce the aerosol direct and first indirect radiative forcings      !jq - introduce the aerosol direct and first indirect radiative forcings
1504      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1505      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1506         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1507         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1508         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1509    
1510         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1511         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &
1512              tau_ae, piz_ae, cg_ae, aerindex)              tau_ae, piz_ae, cg_ae, aerindex)
1513      ELSE      ELSE
1514         tau_ae(:, :, :)=0.0         tau_ae = 0.0
1515         piz_ae(:, :, :)=0.0         piz_ae = 0.0
1516         cg_ae(:, :, :)=0.0         cg_ae = 0.0
1517      ENDIF      ENDIF
1518    
1519      ! Calculer les parametres optiques des nuages et quelques      ! Calculer les parametres optiques des nuages et quelques
1520      ! parametres pour diagnostiques:      ! parametres pour diagnostiques:
1521    
1522      if (ok_newmicro) then      if (ok_newmicro) then
1523         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro (paprs, play, ok_newmicro, &
1524              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1525              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1526              flwp, fiwp, flwc, fiwc, &              flwp, fiwp, flwc, fiwc, &
# Line 1748  contains Line 1529  contains
1529              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
1530              cldtaupi, re, fl)              cldtaupi, re, fl)
1531      else      else
1532         CALL nuage (paprs, pplay, &         CALL nuage (paprs, play, &
1533              t_seri, cldliq, cldfra, cldtau, cldemi, &              t_seri, cldliq, cldfra, cldtau, cldemi, &
1534              cldh, cldl, cldm, cldt, cldq, &              cldh, cldl, cldm, cldt, cldq, &
1535              ok_aie, &              ok_aie, &
# Line 1772  contains Line 1553  contains
1553                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1554         ENDDO         ENDDO
1555         ! nouveau rayonnement (compatible Arpege-IFS):         ! nouveau rayonnement (compatible Arpege-IFS):
1556         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1557              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1558              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1559              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1560              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1561              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)  
1562         itaprad = 0         itaprad = 0
1563      ENDIF      ENDIF
1564      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1796  contains Line 1568  contains
1568      DO k = 1, llm      DO k = 1, llm
1569         DO i = 1, klon         DO i = 1, klon
1570            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1571                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * dtphys/86400.
1572         ENDDO         ENDDO
1573      ENDDO      ENDDO
1574    
1575      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1576         ztit='after rad'         ztit = 'after rad'
1577         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1578              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1579              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1580         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1581              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1582              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1583      END IF      END IF
1584    
1585      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1586      DO i = 1, klon      DO i = 1, klon
1587         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1588         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1825  contains Line 1594  contains
1594         ENDDO         ENDDO
1595      ENDDO      ENDDO
1596    
1597      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1598    
1599      DO i = 1, klon      DO i = 1, klon
1600         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1601      ENDDO      ENDDO
1602    
1603      !moddeblott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1604    
1605      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1606           ! selection des points pour lesquels le shema est actif:
1607         !  selection des points pour lesquels le shema est actif:         igwd = 0
1608         igwd=0         DO i = 1, klon
1609         DO i=1, klon            itest(i) = 0
1610            itest(i)=0            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1611            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN               itest(i) = 1
1612               itest(i)=1               igwd = igwd + 1
1613               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1614            ENDIF            ENDIF
1615         ENDDO         ENDDO
1616    
1617         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1618              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1619              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)  
1620    
1621         !  ajout des tendances         ! ajout des tendances
1622         DO k = 1, llm         DO k = 1, llm
1623            DO i = 1, klon            DO i = 1, klon
1624               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 1863  contains Line 1626  contains
1626               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
1627            ENDDO            ENDDO
1628         ENDDO         ENDDO
1629        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1630    
1631      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1632           ! Sélection des points pour lesquels le schéma est actif :
1633         !  selection des points pour lesquels le shema est actif:         igwd = 0
1634         igwd=0         DO i = 1, klon
1635         DO i=1, klon            itest(i) = 0
1636            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1637            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1638               itest(i)=1               igwd = igwd + 1
1639               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1640            ENDIF            ENDIF
1641         ENDDO         ENDDO
1642    
1643         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1644              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, &  
1645              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1646    
1647         !  ajout des tendances         ! Ajout des tendances :
1648         DO k = 1, llm         DO k = 1, llm
1649            DO i = 1, klon            DO i = 1, klon
1650               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 1894  contains Line 1652  contains
1652               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)
1653            ENDDO            ENDDO
1654         ENDDO         ENDDO
1655        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1656    
1657      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1658    
1659      DO i = 1, klon      DO i = 1, klon
1660         zustrph(i)=0.         zustrph(i) = 0.
1661         zvstrph(i)=0.         zvstrph(i) = 0.
1662      ENDDO      ENDDO
1663      DO k = 1, llm      DO k = 1, llm
1664         DO i = 1, klon         DO i = 1, klon
1665            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1666                 (paprs(i, k)-paprs(i, k+1))/rg            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)
           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1667         ENDDO         ENDDO
1668      ENDDO      ENDDO
1669    
1670      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1671    
1672      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &
1673           ra, rg, romega, &           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &
          rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
1674           aam, torsfc)           aam, torsfc)
1675    
1676      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1677         ztit='after orography'         ztit = 'after orography'
1678         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1679              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1680              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1681      END IF      END IF
1682    
1683      !AA Installation de l'interface online-offline pour traceurs      ! Calcul des tendances traceurs
1684        call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &
1685      !   Calcul  des tendances traceurs           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &
1686             pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1687      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &
1688           dtime, u, v, t, paprs, pplay, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1689           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           tr_seri, zmasse)
          ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &  
          pctsrf, frac_impa,  frac_nucl, &  
          presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &  
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1690    
1691      IF (offline) THEN      IF (offline) THEN
1692           call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1693         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1694         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             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, dtime, itap)  
   
1695      ENDIF      ENDIF
1696    
1697      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1698        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1699             ue, uq)
1700    
1701      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1702    
1703      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, &  
1704           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1705    
1706      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1707    
1708      !+jld ec_conser      ! conversion Ec -> E thermique
1709      DO k = 1, llm      DO k = 1, llm
1710         DO i = 1, klon         DO i = 1, klon
1711            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1712            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1713                 *(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)
1714            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)
1715            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1716         END DO         END DO
1717      END DO      END DO
1718      !-jld ec_conser  
1719      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1720         ztit='after physic'         ztit = 'after physic'
1721         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1722              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1723              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1724         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1725         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1726         !     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.
1727         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1728         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1729              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1730              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1731    
1732         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1733    
1734      END IF      END IF
1735    
1736      !   SORTIES      ! SORTIES
   
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
1737    
1738      !cc prw = eau precipitable      !cc prw = eau precipitable
1739      DO i = 1, klon      DO i = 1, klon
1740         prw(i) = 0.         prw(i) = 0.
1741         DO k = 1, llm         DO k = 1, llm
1742            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  
1743         ENDDO         ENDDO
1744      ENDDO      ENDDO
1745    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1746      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1747    
1748      DO k = 1, llm      DO k = 1, llm
1749         DO i = 1, klon         DO i = 1, klon
1750            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1751            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1752            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1753            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtime            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1754            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtime            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1755         ENDDO         ENDDO
1756      ENDDO      ENDDO
1757    
1758      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1759         DO iq = 3, nq         DO iq = 3, nqmx
1760            DO  k = 1, llm            DO k = 1, llm
1761               DO  i = 1, klon               DO i = 1, klon
1762                  d_qx(i, k, iq) = ( tr_seri(i, k, iq-2) - qx(i, k, iq) ) / dtime                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
1763               ENDDO               ENDDO
1764            ENDDO            ENDDO
1765         ENDDO         ENDDO
1766      ENDIF      ENDIF
1767    
1768      ! 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:
   
1769      DO k = 1, llm      DO k = 1, llm
1770         DO i = 1, klon         DO i = 1, klon
1771            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2048  contains Line 1773  contains
1773         ENDDO         ENDDO
1774      ENDDO      ENDDO
1775    
1776      !   Ecriture des sorties      ! Ecriture des sorties
   
1777      call write_histhf      call write_histhf
1778      call write_histday      call write_histday
1779      call write_histins      call write_histins
1780    
1781      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1782      IF (lafin) THEN      IF (lafin) THEN
1783         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1784         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1785              rlat, rlon, pctsrf, ftsol, ftsoil, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1786              tslab, seaice,  & !IM "slab" ocean              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1787              fqsurf, qsol, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1788              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             solsw, sollwdown, dlw, &  
             radsol, frugs, agesno, &  
             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1789      ENDIF      ENDIF
1790    
1791    contains      firstcal = .FALSE.
   
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la physique ou  
       !IM toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
   
       ! initialisations diverses au "debut" du mois  
   
       IF(MOD(itap, ecrit_mth) == 1) THEN  
          DO i=1, klon  
             nday_rain(i)=0.  
          ENDDO  
       ENDIF  
   
       IF(MOD(itap, ecrit_day) == 0) THEN  
          !IM calcul total_rain, nday_rain  
          DO i = 1, klon  
             total_rain(i)=rain_fall(i)+snow_fall(i)    
             IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.  
          ENDDO  
       ENDIF  
   
     End SUBROUTINE calcul_divers  
1792    
1793      !***********************************************    contains
1794    
1795      subroutine write_histday      subroutine write_histday
1796    
1797        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use gr_phy_write_3d_m, only: gr_phy_write_3d
1798          integer itau_w ! pas de temps ecriture
       if (ok_journe) THEN  
1799    
1800           ndex2d = 0        !------------------------------------------------
          ndex3d = 0  
   
          ! Champs 2D:  
1801    
1802          if (ok_journe) THEN
1803           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1804             if (nqmx <= 4) then
1805           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1806                     gr_phy_write_3d(wo) * 1e3)
1807                ! (convert "wo" from kDU to DU)
1808             end if
1809           if (ok_sync) then           if (ok_sync) then
1810              call histsync(nid_day)              call histsync(nid_day)
1811           endif           endif
   
1812        ENDIF        ENDIF
1813    
1814      End subroutine write_histday      End subroutine write_histday
# Line 2452  contains Line 1817  contains
1817    
1818      subroutine write_histhf      subroutine write_histhf
1819    
1820        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09
   
       ndex2d = 0  
       ndex3d = 0  
1821    
1822        itau_w = itau_phy + itap        !------------------------------------------------
1823    
1824        call write_histhf3d        call write_histhf3d
1825    
# Line 2471  contains Line 1833  contains
1833    
1834      subroutine write_histins      subroutine write_histins
1835    
1836        ! 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
1837    
1838        real zout        real zout
1839          integer itau_w ! pas de temps ecriture
1840    
1841        !--------------------------------------------------        !--------------------------------------------------
1842    
1843        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1844           ! Champs 2D:           ! Champs 2D:
1845    
1846           zsto = dtime * ecrit_ins           zsto = dtphys * ecrit_ins
1847           zout = dtime * ecrit_ins           zout = dtphys * ecrit_ins
1848           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1849    
1850           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1851           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)
1852           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1853    
1854           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1855           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)
1856           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1857    
1858           DO i = 1, klon           DO i = 1, klon
1859              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1860           ENDDO           ENDDO
1861           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)
1862           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1863    
1864           DO i = 1, klon           DO i = 1, klon
1865              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1866           ENDDO           ENDDO
1867           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)
1868           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1869    
1870           DO i = 1, klon           DO i = 1, klon
1871              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1872           ENDDO           ENDDO
1873           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)
1874           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1875    
1876           DO i = 1, klon           DO i = 1, klon
1877              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1878           ENDDO           ENDDO
1879           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)
1880           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1881    
1882           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)
1883           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1884           !ccIM           !ccIM
1885           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)
1886           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1887    
1888           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)
1889           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1890    
1891           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)
1892           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1893    
1894           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)
1895           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1896    
1897           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)
1898           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1899    
1900           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)
1901           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1902    
1903           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)
1904           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1905    
1906           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)
1907           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1908    
1909           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)
1910           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1911    
1912           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)
1913           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1914    
1915           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)
1916           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1917    
1918           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)
1919           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
1920    
1921           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)
1922           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1923    
1924           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1925           !     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)
1926           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)
1927           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1928    
1929           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)
1930           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1931    
1932           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)
1933           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
1934    
1935           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)
1936           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
1937    
1938           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)
1939           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
1940    
1941           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)
1942           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
1943    
1944           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1945              !XXX              !XXX
1946              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1947              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)
1948              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1949                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1950    
1951              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1952              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)
1953              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1954                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1955    
1956              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1957              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)
1958              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1959                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1960    
1961              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1962              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)
1963              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1964                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1965    
1966              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1967              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)
1968              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1969                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1970    
1971              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1972              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)
1973              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1974                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1975    
1976              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1977              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)
1978              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1979                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1980    
1981              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1982              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)
1983              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1984                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1985    
1986              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1987              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)
1988              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1989                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1990    
1991           END DO           END DO
1992           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)
1993           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1994           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)
1995           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1996    
1997           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)
1998           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
   
          !IM cf. AM 081204 BEG  
1999    
2000           !HBTM2           !HBTM2
2001    
2002           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)
2003           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
2004    
2005           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)
2006           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
2007    
2008           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)
2009           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
2010    
2011           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)
2012           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
2013    
2014           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)
2015           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
2016    
2017           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)
2018           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
2019    
2020           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)
2021           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
2022    
2023           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)
2024           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
2025    
2026           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)
2027           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
2028    
2029           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)
2030           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
               ndex2d)  
   
          !IM cf. AM 081204 END  
2031    
2032           ! Champs 3D:           ! Champs 3D:
2033    
2034           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)
2035           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2036    
2037           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)
2038           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2039    
2040           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)
2041           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2042    
2043           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)
2044           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2045    
2046           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)
2047           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2048    
2049           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)
2050           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2051    
2052           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)
2053           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2054    
2055           if (ok_sync) then           if (ok_sync) then
2056              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2727  contains Line 2063  contains
2063    
2064      subroutine write_histhf3d      subroutine write_histhf3d
2065    
2066        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09
2067    
2068        ndex2d = 0        integer itau_w ! pas de temps ecriture
2069        ndex3d = 0  
2070          !-------------------------------------------------------
2071    
2072        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2073    
2074        ! Champs 3D:        ! Champs 3D:
2075    
2076        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)
2077        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2078    
2079        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)
2080        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2081    
2082        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)
2083        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2084    
2085        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)
2086        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2087    
2088        if (nbtr >= 3) then        if (nbtr >= 3) then
2089           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &
2090                zx_tmp_3d)                zx_tmp_3d)
2091           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, &           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
               ndex3d)  
2092        end if        end if
2093    
2094        if (ok_sync) then        if (ok_sync) then
# Line 2767  contains Line 2099  contains
2099    
2100    END SUBROUTINE physiq    END SUBROUTINE physiq
2101    
   !****************************************************  
   
   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  
   
2102  end module physiq_m  end module physiq_m
Legend:
Removed from v.6  
changed lines
  Added in v.51
  ViewVC Help
Powered by ViewVC 1.1.21