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

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

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

revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC
# Line 10  contains Line 10  contains
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)
11      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
12    
13      ! Objet : moniteur général de la physique du modèle      ! This is the main procedure for the "physics" part of the program.
14    
15      use abort_gcm_m, only: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
16      USE calendar, only: ymds2ju      USE calendar, ONLY: ymds2ju
17      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &      use calltherm_m, only: calltherm
18           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
20           cycle_diurne, new_oliq, soil_model      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
21      use clmain_m, only: clmain           ok_orodr, ok_orolf, soil_model
22      use comgeomphy      USE clmain_m, ONLY: clmain
23      use concvl_m, only: concvl      USE comgeomphy, ONLY: airephy, cuphy, cvphy
24      use conf_gcm_m, only: raz_date, offline      USE concvl_m, ONLY: concvl
25      use conf_phys_m, only: conf_phys      USE conf_gcm_m, ONLY: offline, raz_date
26      use ctherm      USE conf_phys_m, ONLY: conf_phys
27      use dimens_m, only: jjm, iim, llm, nqmx      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
28      use dimphy, only: klon, nbtr      use diagcld2_m, only: diagcld2
29      use dimsoil, only: nsoilmx      use diagetpq_m, only: diagetpq
30      use hgardfou_m, only: hgardfou      USE dimens_m, ONLY: iim, jjm, llm, nqmx
31      USE histcom, only: histsync      USE dimphy, ONLY: klon, nbtr
32      USE histwrite_m, only: histwrite      USE dimsoil, ONLY: nsoilmx
33      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      use drag_noro_m, only: drag_noro
34      use ini_histhf_m, only: ini_histhf      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
35      use ini_histday_m, only: ini_histday      USE hgardfou_m, ONLY: hgardfou
36      use ini_histins_m, only: ini_histins      USE histcom, ONLY: histsync
37      use iniprint, only: prt_level      USE histwrite_m, ONLY: histwrite
38      use oasis_m      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
39      use orbite_m, only: orbite, zenang           nbsrf
40      use ozonecm_m, only: ozonecm      USE ini_histhf_m, ONLY: ini_histhf
41      use phyetat0_m, only: phyetat0, rlat, rlon      USE ini_histday_m, ONLY: ini_histday
42      use phyredem_m, only: phyredem      USE ini_histins_m, ONLY: ini_histins
43      use phystokenc_m, only: phystokenc      USE oasis_m, ONLY: ok_oasis
44      use phytrac_m, only: phytrac      USE orbite_m, ONLY: orbite, zenang
45      use qcheck_m, only: qcheck      USE ozonecm_m, ONLY: ozonecm
46      use radepsi      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
47      use radopt      USE phyredem_m, ONLY: phyredem
48      use temps, only: itau_phy, day_ref, annee_ref      USE phystokenc_m, ONLY: phystokenc
49      use yoethf_m      USE phytrac_m, ONLY: phytrac
50      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE qcheck_m, ONLY: qcheck
51        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
52        USE temps, ONLY: annee_ref, day_ref, itau_phy
53        USE yoethf_m, ONLY: r2es, rvtmp2
54    
55      ! Declaration des constantes et des fonctions thermodynamiques :      ! Arguments:
     use fcttre, only: thermcep, foeew, qsats, qsatl  
   
     ! Variables argument:  
56    
57      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
58      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
# Line 61  contains Line 61  contains
61      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
62      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
63    
64      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
65      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
66    
67      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 70  contains Line 70  contains
70      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
71      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
72    
73      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
74    
75      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
76      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
77        
78      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
79      REAL t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
80    
81      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
82      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
# Line 84  contains Line 84  contains
84      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
85      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
86      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
87      REAL d_t(klon, llm) ! output tendance physique de "t" (K/s)      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
88      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
89      REAL d_ps(klon) ! output tendance physique de la pression au sol      REAL d_ps(klon) ! output tendance physique de la pression au sol
90    
91      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
92    
93      INTEGER nbteta      INTEGER nbteta
94      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
95    
96      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
97      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
98    
99      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
100      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
101      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
102      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
103    
104      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
105      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
106      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
107      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
108        ! Ajouter artificiellement les stratus
109    
110      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
111      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
112      logical rnpb      logical rnpb
113      parameter(rnpb=.true.)      parameter(rnpb = .true.)
114    
115      character(len=6), save:: ocean      character(len = 6), save:: ocean
116      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
117    
118      logical ok_ocean      logical ok_ocean
119      SAVE ok_ocean      SAVE ok_ocean
120    
121      !IM "slab" ocean      ! "slab" ocean
122      REAL tslab(klon) !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
123      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
124      REAL seaice(klon) !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
125      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  
126    
127      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
128      logical, save:: ok_veget      logical, save:: ok_veget
# Line 135  contains Line 134  contains
134      save ok_instan      save ok_instan
135    
136      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
137      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
138    
139      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
140      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
141      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
142      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
143    
144      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
145      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
146      INTEGER iliq ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
147      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
148    
149      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
150      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
151    
152      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
153      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)
# Line 159  contains Line 156  contains
156    
157      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
158    
159      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
160      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
161      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
162      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 167  contains Line 164  contains
164      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
165    
166      INTEGER klevp1      INTEGER klevp1
167      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
168    
169      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
170      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
# Line 181  contains Line 178  contains
178      ! variables a une pression donnee      ! variables a une pression donnee
179    
180      integer nlevSTD      integer nlevSTD
181      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
182      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
183      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
184           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
185           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
186      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
187      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
188           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
189           '70 ', '50 ', '30 ', '20 ', '10 '/           '70 ', '50 ', '30 ', '20 ', '10 '/
# Line 200  contains Line 197  contains
197      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
198    
199      INTEGER kmax, lmax      INTEGER kmax, lmax
200      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
201      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
202      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
203    
204      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
205      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 213  contains Line 210  contains
210      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
211    
212      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
213      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
214    
215      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
216      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
217      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
218    
219      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
220      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', &
221           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
222           '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 262  contains Line 259  contains
259    
260      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
261    
262      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol ! temperature du sol  
263    
264      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
265      SAVE ftsoil ! temperature dans le sol      ! soil temperature of surface fraction
266    
267      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
268      SAVE fevap ! evaporation      SAVE fevap ! evaporation
# Line 276  contains Line 272  contains
272      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
273      SAVE fqsurf ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
274    
275      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol ! hauteur d'eau dans le sol  
276    
277      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
278      SAVE fsnow ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
# Line 444  contains Line 439  contains
439      SAVE itaprad      SAVE itaprad
440    
441      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
442      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
443    
444      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
445      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 459  contains Line 454  contains
454      LOGICAL zx_ajustq      LOGICAL zx_ajustq
455    
456      REAL za, zb      REAL za, zb
457      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
458      real zqsat(klon, llm)      real zqsat(klon, llm)
459      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
460      REAL t_coup      REAL t_coup
461      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
462    
463      REAL zphi(klon, llm)      REAL zphi(klon, llm)
464    
465      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
466    
467      REAL pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
468      REAL plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
469      REAL capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
470      REAL oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
471      REAL cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
472      REAL pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
473      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
474      REAL trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
475      REAL trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
476      REAL trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
477      ! Grdeurs de sorties      ! Grdeurs de sorties
478      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
479      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 508  contains Line 503  contains
503      ! Variables du changement      ! Variables du changement
504    
505      ! con: convection      ! con: convection
506      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
507      ! ajs: ajustement sec      ! ajs: ajustement sec
508      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
509      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
510      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
511      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
512      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 523  contains Line 518  contains
518      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
519      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
520      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
521      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
522      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)  
523    
524      SAVE ibas_con, itop_con      INTEGER,save:: ibas_con(klon), itop_con(klon)
525    
526      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
527      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 558  contains Line 551  contains
551    
552      logical ptconv(klon, llm)      logical ptconv(klon, llm)
553    
554      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en série :
555    
556      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
557      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 574  contains Line 567  contains
567      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
568      REAL aam, torsfc      REAL aam, torsfc
569    
570      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
571    
572      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
573      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)
# Line 588  contains Line 581  contains
581    
582      REAL zsto      REAL zsto
583    
584      character(len=20) modname      character(len = 20) modname
585      character(len=80) abort_message      character(len = 80) abort_message
586      logical ok_sync      logical ok_sync
587      real date0      real date0
588    
589      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
590      REAL ztsol(klon)      REAL ztsol(klon)
591      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
592      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
593      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
     SAVE d_h_vcol_phy  
594      REAL zero_v(klon)      REAL zero_v(klon)
595      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) ztit
596      INTEGER ip_ebil ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
     SAVE ip_ebil  
     DATA ip_ebil/0/  
597      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
598      !+jld ec_conser  
599      REAL d_t_ec(klon, llm) ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
600      REAL ZRCPD      REAL ZRCPD
601      !-jld ec_conser  
602      !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  
603      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
604      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
605      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
606      !jq Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
607      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
608    
609      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
610      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
611    
612      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
613      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
# Line 632  contains Line 620  contains
620      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
621    
622      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
623      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
624    
625      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
626      ! ok_aie=T ->      ! ok_aie = True ->
627      ! ok_ade=T -AIE=topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
628      ! ok_ade=F -AIE=topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
629    
630      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
631    
# Line 665  contains Line 653  contains
653      SAVE d_v_con      SAVE d_v_con
654      SAVE rnebcon0      SAVE rnebcon0
655      SAVE clwcon0      SAVE clwcon0
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
656    
657      real zmasse(klon, llm)      real zmasse(klon, llm)
658      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
# Line 685  contains Line 663  contains
663    
664      modname = 'physiq'      modname = 'physiq'
665      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
666         DO i=1, klon         DO i = 1, klon
667            zero_v(i)=0.            zero_v(i) = 0.
668         END DO         END DO
669      END IF      END IF
670      ok_sync=.TRUE.      ok_sync = .TRUE.
671      IF (nqmx < 2) THEN      IF (nqmx < 2) THEN
672         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
673         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
# Line 697  contains Line 675  contains
675    
676      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
677         ! initialiser         ! initialiser
678         u10m=0.         u10m = 0.
679         v10m=0.         v10m = 0.
680         t2m=0.         t2m = 0.
681         q2m=0.         q2m = 0.
682         ffonte=0.         ffonte = 0.
683         fqcalving=0.         fqcalving = 0.
684         piz_ae=0.         piz_ae = 0.
685         tau_ae=0.         tau_ae = 0.
686         cg_ae=0.         cg_ae = 0.
687         rain_con(:)=0.         rain_con(:) = 0.
688         snow_con(:)=0.         snow_con(:) = 0.
689         bl95_b0=0.         bl95_b0 = 0.
690         bl95_b1=0.         bl95_b1 = 0.
691         topswai(:)=0.         topswai(:) = 0.
692         topswad(:)=0.         topswad(:) = 0.
693         solswai(:)=0.         solswai(:) = 0.
694         solswad(:)=0.         solswad(:) = 0.
695    
696         d_u_con = 0.0         d_u_con = 0.0
697         d_v_con = 0.0         d_v_con = 0.0
# Line 733  contains Line 711  contains
711         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
712         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
713    
714         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
715    
716         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
717    
# Line 750  contains Line 728  contains
728         itap = 0         itap = 0
729         itaprad = 0         itaprad = 0
730         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
731              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
732              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
733              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
734              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0)  
735    
736         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
737         q2=1.e-8         q2 = 1.e-8
738    
739         radpas = NINT( 86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
740    
741         ! on remet le calendrier a zero         ! on remet le calendrier a zero
742         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 768  contains Line 744  contains
744         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
745    
746         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
747            ok_ocean=.TRUE.            ok_ocean = .TRUE.
748         ENDIF         ENDIF
749    
750         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
751              ok_region)              ok_region)
752    
753         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
754            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
755            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
756            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
757            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
758         ENDIF         ENDIF
759         print *,"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con = ", iflag_con
760         print *,"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl = ", &
761              ok_cvl              ok_cvl
762    
763         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
# Line 819  contains Line 795  contains
795         npas = 0         npas = 0
796         nexca = 0         nexca = 0
797    
798         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
799    
800         ! Initialisation des sorties         ! Initialisation des sorties
801    
# Line 828  contains Line 804  contains
804         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
805         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
806         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
807         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
808      ENDIF test_firstcal      ENDIF test_firstcal
809    
810      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 836  contains Line 812  contains
812      DO i = 1, klon      DO i = 1, klon
813         d_ps(i) = 0.0         d_ps(i) = 0.0
814      ENDDO      ENDDO
     DO k = 1, llm  
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
815      DO iq = 1, nqmx      DO iq = 1, nqmx
816         DO k = 1, llm         DO k = 1, llm
817            DO i = 1, klon            DO i = 1, klon
# Line 850  contains Line 819  contains
819            ENDDO            ENDDO
820         ENDDO         ENDDO
821      ENDDO      ENDDO
822      da=0.      da = 0.
823      mp=0.      mp = 0.
824      phi=0.      phi = 0.
825    
826      ! 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 :
827    
828      DO k = 1, llm      DO k = 1, llm
829         DO i = 1, klon         DO i = 1, klon
# Line 882  contains Line 851  contains
851      ENDDO      ENDDO
852    
853      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
854         ztit='after dynamic'         ztit = 'after dynamics'
855         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
856              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
857              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
858         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
859         ! on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
860         ! est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
861         ! Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
862           !  nulle.
863         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
864              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
865              d_qt, 0., fs_bound, fq_bound )              d_qt, 0., fs_bound, fq_bound)
866      END IF      END IF
867    
868      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
869      IF (ancien_ok) THEN      IF (ancien_ok) THEN
870         DO k = 1, llm         DO k = 1, llm
871            DO i = 1, klon            DO i = 1, klon
872               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtphys               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
873               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtphys               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
874            ENDDO            ENDDO
875         ENDDO         ENDDO
876      ELSE      ELSE
# Line 915  contains Line 884  contains
884      ENDIF      ENDIF
885    
886      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
887      DO k = 1, llm      DO k = 1, llm
888         DO i = 1, klon         DO i = 1, klon
889            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
890         ENDDO         ENDDO
891      ENDDO      ENDDO
892    
893      ! Verifier les temperatures      ! Check temperatures:
   
894      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
895    
896      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
897      itap = itap + 1      itap = itap + 1
898      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
899      if (julien == 0) julien = 360      if (julien == 0) julien = 360
900    
901      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
902    
903      ! 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.  
904    
905        ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
906      if (nqmx >= 5) then      if (nqmx >= 5) then
907         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
908      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
909         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
910      ENDIF      ENDIF
911    
912      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
913        DO k = 1, llm
     DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse  
914         DO i = 1, klon         DO i = 1, klon
915            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
916            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
917            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  
918            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
919         ENDDO         ENDDO
920      ENDDO      ENDDO
921        ql_seri = 0.
922    
923      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
924         ztit='after reevap'         ztit = 'after reevap'
925         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
926              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
927              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
928         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
929              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
930              fs_bound, fq_bound )              fs_bound, fq_bound)
931    
932      END IF      END IF
933    
# Line 997  contains Line 958  contains
958      ENDIF      ENDIF
959    
960      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
961      albsol(:)=0.      albsol(:) = 0.
962      albsollw(:)=0.      albsollw(:) = 0.
963      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
964         DO i = 1, klon         DO i = 1, klon
965            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1034  contains Line 995  contains
995    
996      ! Incrémentation des flux      ! Incrémentation des flux
997    
998      zxfluxt=0.      zxfluxt = 0.
999      zxfluxq=0.      zxfluxq = 0.
1000      zxfluxu=0.      zxfluxu = 0.
1001      zxfluxv=0.      zxfluxv = 0.
1002      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1003         DO k = 1, llm         DO k = 1, llm
1004            DO i = 1, klon            DO i = 1, klon
1005               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + &
1006                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1007               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxq(i, k) = zxfluxq(i, k) + &
1008                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1009               zxfluxu(i, k) = zxfluxu(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + &
1010                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1011               zxfluxv(i, k) = zxfluxv(i, k) + &               zxfluxv(i, k) = zxfluxv(i, k) + &
1012                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1013            END DO            END DO
1014         END DO         END DO
1015      END DO      END DO
# Line 1068  contains Line 1029  contains
1029      ENDDO      ENDDO
1030    
1031      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1032         ztit='after clmain'         ztit = 'after clmain'
1033         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1034              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1035              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1036         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1037              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1038              fs_bound, fq_bound )              fs_bound, fq_bound)
1039      END IF      END IF
1040    
1041      ! Incrementer la temperature du sol      ! Update surface temperature:
1042    
1043      DO i = 1, klon      DO i = 1, klon
1044         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1101  contains Line 1062  contains
1062         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1063         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1064    
1065         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1066              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1067              THEN              THEN
1068            WRITE(*, *) 'physiq : pb sous surface au point ', i, &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1069                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
# Line 1147  contains Line 1108  contains
1108            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1109            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
1110                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1111            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1112            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1113            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1114            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1115            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1116            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1117            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1118            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1119            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1120            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1121         ENDDO         ENDDO
1122      ENDDO      ENDDO
1123    
# Line 1178  contains Line 1139  contains
1139      ENDDO      ENDDO
1140      IF (check) THEN      IF (check) THEN
1141         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1142         print *, "avantcon=", za         print *, "avantcon = ", za
1143      ENDIF      ENDIF
1144      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1145      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1146      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1147         DO i = 1, klon         DO i = 1, klon
1148            z_avant(i) = 0.0            z_avant(i) = 0.0
1149         ENDDO         ENDDO
1150         DO k = 1, llm         DO k = 1, llm
1151            DO i = 1, klon            DO i = 1, klon
1152               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)) &
1153                    *zmasse(i, k)                    *zmasse(i, k)
1154            ENDDO            ENDDO
1155         ENDDO         ENDDO
1156      ENDIF      ENDIF
1157      IF (iflag_con == 1) THEN  
1158         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1159      ELSE IF (iflag_con == 2) THEN      case (1)
1160         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1161              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1162              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1163              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1164              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1165                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1166                pmflxs)
1167         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1168         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1169         DO i = 1, klon         DO i = 1, klon
1170            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1171            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1172         ENDDO         ENDDO
1173      ELSE IF (iflag_con >= 3) THEN      case (3:)
1174         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1175         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1176         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1177         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1178         ntra = 1         ntra = 1
1179         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1180         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1181    
1182         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1183              ! new driver for convectL
1184            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1185                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1186                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1187                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1188                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1189                 pmflxs, da, phi, mp)                 pmflxs, da, phi, mp)
1190              clwcon0 = qcondc
1191            clwcon0=qcondc            pmfu = upwd + dnwd
           pmfu=upwd+dnwd  
1192         ELSE         ELSE
1193            ! MAF conema3 ne contient pas les traceurs            ! conema3 ne contient pas les traceurs
1194            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &            CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1195                 u_seri, v_seri, tr_seri, ntra, &                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1196                 ema_work1, ema_work2, &                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1197                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &
1198                 rain_con, snow_con, ibas_con, itop_con, &                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1199                 upwd, dnwd, dnwd0, bas, top, &         ENDIF
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
1200    
1201         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1202            do i = 1, klon            do i = 1, klon
1203               wd(i)=0.0               wd(i) = 0.0
1204            enddo            enddo
1205         ENDIF         ENDIF
1206    
1207         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1208    
1209         DO k = 1, llm         DO k = 1, llm
1210            DO i = 1, klon            DO i = 1, klon
# Line 1264  contains Line 1222  contains
1222                     zx_qs = qsatl(zx_t)/play(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1223                  ENDIF                  ENDIF
1224               ENDIF               ENDIF
1225               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1226            ENDDO            ENDDO
1227         ENDDO         ENDDO
1228    
1229         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1230         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1231         call clouds_gno &         call clouds_gno &
1232              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1233      ELSE      case default
1234         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1235         stop 1         stop 1
1236      ENDIF      END select
1237    
1238      DO k = 1, llm      DO k = 1, llm
1239         DO i = 1, klon         DO i = 1, klon
# Line 1287  contains Line 1245  contains
1245      ENDDO      ENDDO
1246    
1247      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1248         ztit='after convect'         ztit = 'after convect'
1249         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1250              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1251              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1252         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1253              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1254              fs_bound, fq_bound )              fs_bound, fq_bound)
1255      END IF      END IF
1256    
1257      IF (check) THEN      IF (check) THEN
1258         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1259         print *,"aprescon=", za         print *,"aprescon = ", za
1260         zx_t = 0.0         zx_t = 0.0
1261         za = 0.0         za = 0.0
1262         DO i = 1, klon         DO i = 1, klon
# Line 1307  contains Line 1265  contains
1265                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1266         ENDDO         ENDDO
1267         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1268         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1269      ENDIF      ENDIF
1270      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1271         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 1273  contains
1273         ENDDO         ENDDO
1274         DO k = 1, llm         DO k = 1, llm
1275            DO i = 1, klon            DO i = 1, klon
1276               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)) &
1277                    *zmasse(i, k)                    *zmasse(i, k)
1278            ENDDO            ENDDO
1279         ENDDO         ENDDO
1280         DO i = 1, klon         DO i = 1, klon
1281            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1282                 /z_apres(i)                 /z_apres(i)
1283         ENDDO         ENDDO
1284         DO k = 1, llm         DO k = 1, llm
1285            DO i = 1, klon            DO i = 1, klon
1286               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1287                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1288               ENDIF               ENDIF
1289            ENDDO            ENDDO
1290         ENDDO         ENDDO
1291      ENDIF      ENDIF
1292      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1293    
1294      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1295    
1296      d_t_ajs=0.      d_t_ajs = 0.
1297      d_u_ajs=0.      d_u_ajs = 0.
1298      d_v_ajs=0.      d_v_ajs = 0.
1299      d_q_ajs=0.      d_q_ajs = 0.
1300      fm_therm=0.      fm_therm = 0.
1301      entr_therm=0.      entr_therm = 0.
1302    
1303      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1304         ! Ajustement sec         ! Ajustement sec
# Line 1355  contains Line 1312  contains
1312      endif      endif
1313    
1314      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1315         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1316         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1317              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1318              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1363  contains Line 1320  contains
1320    
1321      ! Caclul des ratqs      ! Caclul des ratqs
1322    
1323      ! 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
1324      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1325      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1326         do k=1, llm         do k = 1, llm
1327            do i=1, klon            do i = 1, klon
1328               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1329                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1330                       +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)
1331               else               else
1332                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1333               endif               endif
1334            enddo            enddo
1335         enddo         enddo
1336      endif      endif
1337    
1338      ! ratqs stables      ! ratqs stables
1339      do k=1, llm      do k = 1, llm
1340         do i=1, klon         do i = 1, klon
1341            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1342                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1343         enddo         enddo
1344      enddo      enddo
# Line 1392  contains Line 1349  contains
1349         ! ratqs final         ! ratqs final
1350         ! 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
1351         ! relaxation des ratqs         ! relaxation des ratqs
1352         facteur=exp(-dtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1353         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1354         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1355      else      else
1356         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1357         ratqs=ratqss         ratqs = ratqss
1358      endif      endif
1359    
1360      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1361      ! et le processus de precipitation      ! précipitation :
1362      CALL fisrtilp(dtphys, paprs, play, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1363           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1364           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1365           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1366    
1367      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1368      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1423  contains Line 1377  contains
1377      ENDDO      ENDDO
1378      IF (check) THEN      IF (check) THEN
1379         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1380         print *,"apresilp=", za         print *,"apresilp = ", za
1381         zx_t = 0.0         zx_t = 0.0
1382         za = 0.0         za = 0.0
1383         DO i = 1, klon         DO i = 1, klon
# Line 1432  contains Line 1386  contains
1386                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1387         ENDDO         ENDDO
1388         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1389         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1390      ENDIF      ENDIF
1391    
1392      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1393         ztit='after fisrt'         ztit = 'after fisrt'
1394         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1395              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1396              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1397         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1398              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1399              fs_bound, fq_bound )              fs_bound, fq_bound)
1400      END IF      END IF
1401    
1402      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
# Line 1450  contains Line 1404  contains
1404      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1405    
1406      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1407         snow_tiedtke=0.         snow_tiedtke = 0.
1408         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1409            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1410         else         else
1411            rain_tiedtke=0.            rain_tiedtke = 0.
1412            do k=1, llm            do k = 1, llm
1413               do i=1, klon               do i = 1, klon
1414                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1415                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1416                          *zmasse(i, k)                          *zmasse(i, k)
1417                  endif                  endif
1418               enddo               enddo
# Line 1471  contains Line 1425  contains
1425              diafra, dialiq)              diafra, dialiq)
1426         DO k = 1, llm         DO k = 1, llm
1427            DO i = 1, klon            DO i = 1, klon
1428               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1429                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1430                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1431               ENDIF               ENDIF
1432            ENDDO            ENDDO
1433         ENDDO         ENDDO
   
1434      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1435         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1436         ! 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
1437         ! facttemps         ! facttemps
1438         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1439         do k=1, llm         do k = 1, llm
1440            do i=1, klon            do i = 1, klon
1441               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1442               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)) &
1443                    then                    then
1444                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1445                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1446               endif               endif
1447            enddo            enddo
1448         enddo         enddo
1449    
1450         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1451         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1452         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1453      ENDIF      ENDIF
1454    
1455      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1456    
1457      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1458         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1459         DO k = 1, llm         DO k = 1, llm
1460            DO i = 1, klon            DO i = 1, klon
1461               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1462                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1463                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1464               ENDIF               ENDIF
# Line 1522  contains Line 1474  contains
1474      ENDDO      ENDDO
1475    
1476      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1477         ztit="after diagcld"         ztit = "after diagcld"
1478         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1479              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1480              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1481      END IF      END IF
1482    
1483      ! Calculer l'humidite relative pour diagnostique      ! Humidité relative pour diagnostic:
   
1484      DO k = 1, llm      DO k = 1, llm
1485         DO i = 1, klon         DO i = 1, klon
1486            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1547  contains Line 1498  contains
1498               ENDIF               ENDIF
1499            ENDIF            ENDIF
1500            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1501            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1502         ENDDO         ENDDO
1503      ENDDO      ENDDO
1504      !jq - introduce the aerosol direct and first indirect radiative forcings  
1505      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1506      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1507        IF (ok_ade .OR. ok_aie) THEN
1508         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1509         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1510         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1511    
1512         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1513         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1514              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1515      ELSE      ELSE
1516         tau_ae=0.0         tau_ae = 0.
1517         piz_ae=0.0         piz_ae = 0.
1518         cg_ae=0.0         cg_ae = 0.
1519      ENDIF      ENDIF
1520    
1521      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour
1522      ! parametres pour diagnostiques:      ! diagnostics :
   
1523      if (ok_newmicro) then      if (ok_newmicro) then
1524         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1525              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1526              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1527              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1528      else      else
1529         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1530              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1531              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1532      endif      endif
1533    
1534      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1535      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1536         DO i = 1, klon         DO i = 1, klon
1537            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1617  contains Line 1558  contains
1558    
1559      DO k = 1, llm      DO k = 1, llm
1560         DO i = 1, klon         DO i = 1, klon
1561            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * dtphys/86400.  
1562         ENDDO         ENDDO
1563      ENDDO      ENDDO
1564    
1565      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1566         ztit='after rad'         ztit = 'after rad'
1567         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1568              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1569              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1570         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1571              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1572              fs_bound, fq_bound )              fs_bound, fq_bound)
1573      END IF      END IF
1574    
1575      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1576      DO i = 1, klon      DO i = 1, klon
1577         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1578         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1645  contains Line 1584  contains
1584         ENDDO         ENDDO
1585      ENDDO      ENDDO
1586    
1587      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1588    
1589      DO i = 1, klon      DO i = 1, klon
1590         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1591      ENDDO      ENDDO
1592    
1593      !mod deb lott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1594    
1595      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1596         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1597         igwd=0         igwd = 0
1598         DO i=1, klon         DO i = 1, klon
1599            itest(i)=0            itest(i) = 0
1600            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1601               itest(i)=1               itest(i) = 1
1602               igwd=igwd+1               igwd = igwd + 1
1603               idx(igwd)=i               idx(igwd) = i
1604            ENDIF            ENDIF
1605         ENDDO         ENDDO
1606    
1607         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1608              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1609              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)  
1610    
1611         ! ajout des tendances         ! ajout des tendances
1612         DO k = 1, llm         DO k = 1, llm
# Line 1685  contains Line 1619  contains
1619      ENDIF      ENDIF
1620    
1621      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1622           ! Sélection des points pour lesquels le schéma est actif :
1623         ! selection des points pour lesquels le shema est actif:         igwd = 0
1624         igwd=0         DO i = 1, klon
1625         DO i=1, klon            itest(i) = 0
1626            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1627            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1628               itest(i)=1               igwd = igwd + 1
1629               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1630            ENDIF            ENDIF
1631         ENDDO         ENDDO
1632    
# Line 1701  contains Line 1634  contains
1634              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1635              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1636    
1637         ! ajout des tendances         ! Ajout des tendances :
1638         DO k = 1, llm         DO k = 1, llm
1639            DO i = 1, klon            DO i = 1, klon
1640               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 1709  contains Line 1642  contains
1642               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)
1643            ENDDO            ENDDO
1644         ENDDO         ENDDO
1645        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1646    
1647      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1648    
1649      DO i = 1, klon      DO i = 1, klon
1650         zustrph(i)=0.         zustrph(i) = 0.
1651         zvstrph(i)=0.         zvstrph(i) = 0.
1652      ENDDO      ENDDO
1653      DO k = 1, llm      DO k = 1, llm
1654         DO i = 1, klon         DO i = 1, klon
1655            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1656            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))/dtphys* zmasse(i, k)
1657         ENDDO         ENDDO
1658      ENDDO      ENDDO
1659    
# Line 1732  contains Line 1664  contains
1664           aam, torsfc)           aam, torsfc)
1665    
1666      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1667         ztit='after orography'         ztit = 'after orography'
1668         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1669              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1670              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1758  contains Line 1690  contains
1690    
1691      ! diag. bilKP      ! diag. bilKP
1692    
1693      CALL transp_lay (paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
1694           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1695    
1696      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1697    
1698      !+jld ec_conser      ! conversion Ec -> E thermique
1699      DO k = 1, llm      DO k = 1, llm
1700         DO i = 1, klon         DO i = 1, klon
1701            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1702            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1703                 *(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)
1704            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)
1705            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1706         END DO         END DO
1707      END DO      END DO
1708      !-jld ec_conser  
1709      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1710         ztit='after physic'         ztit = 'after physic'
1711         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1712              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1713              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1785  contains Line 1717  contains
1717         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1718         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1719              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1720              fs_bound, fq_bound )              fs_bound, fq_bound)
1721    
1722         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1723    
1724      END IF      END IF
1725    
# Line 1805  contains Line 1737  contains
1737    
1738      DO k = 1, llm      DO k = 1, llm
1739         DO i = 1, klon         DO i = 1, klon
1740            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1741            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1742            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1743            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1744            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1745         ENDDO         ENDDO
1746      ENDDO      ENDDO
1747    
# Line 1839  contains Line 1771  contains
1771      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1772      IF (lafin) THEN      IF (lafin) THEN
1773         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1774         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1775              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1776              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1777              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1778              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1779      ENDIF      ENDIF
1780    
1781      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1908  contains Line 1838  contains
1838           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1839    
1840           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1841           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)
1842           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1843    
1844           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1845           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)
1846           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1847    
1848           DO i = 1, klon           DO i = 1, klon
1849              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1850           ENDDO           ENDDO
1851           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)
1852           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1853    
1854           DO i = 1, klon           DO i = 1, klon
1855              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1856           ENDDO           ENDDO
1857           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)
1858           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1859    
1860           DO i = 1, klon           DO i = 1, klon
1861              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1862           ENDDO           ENDDO
1863           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)
1864           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1865    
1866           DO i = 1, klon           DO i = 1, klon
1867              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1868           ENDDO           ENDDO
1869           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)
1870           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1871    
1872           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)
1873           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1874           !ccIM           !ccIM
1875           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)
1876           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1877    
1878           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)
1879           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1880    
1881           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)
1882           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1883    
1884           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)
1885           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1886    
1887           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)
1888           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1889    
1890           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)
1891           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1892    
1893           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)
1894           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1895    
1896           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)
1897           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1898    
1899           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)
1900           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1901    
1902           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)
1903           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1904    
1905           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)
1906           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1907    
1908           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)
1909           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1910    
1911           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)
1912           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1913    
1914           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1915           ! 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)
1916           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)
1917           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1918    
1919           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)
1920           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1921    
1922           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)
1923           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1924    
1925           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)
1926           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1927    
1928           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)
1929           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1930    
1931           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)
1932           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1933    
1934           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1935              !XXX              !XXX
1936              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1937              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)
1938              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1939                   zx_tmp_2d)                   zx_tmp_2d)
1940    
1941              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1942              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)
1943              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1944                   zx_tmp_2d)                   zx_tmp_2d)
1945    
1946              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
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, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1949                   zx_tmp_2d)                   zx_tmp_2d)
1950    
1951              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(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, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1954                   zx_tmp_2d)                   zx_tmp_2d)
1955    
1956              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, 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, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1959                   zx_tmp_2d)                   zx_tmp_2d)
1960    
1961              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, 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, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1964                   zx_tmp_2d)                   zx_tmp_2d)
1965    
1966              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, 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, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1969                   zx_tmp_2d)                   zx_tmp_2d)
1970    
1971              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, 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, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1974                   zx_tmp_2d)                   zx_tmp_2d)
1975    
1976              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, 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, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1979                   zx_tmp_2d)                   zx_tmp_2d)
1980    
1981           END DO           END DO
1982           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)
1983           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1984           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)
1985           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1986    
1987           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)
1988           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1989    
          !IM cf. AM 081204 BEG  
   
1990           !HBTM2           !HBTM2
1991    
1992           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)
1993           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1994    
1995           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)
1996           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1997    
1998           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)
1999           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
2000    
2001           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)
2002           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
2003    
2004           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)
2005           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
2006    
2007           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)
2008           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
2009    
2010           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)
2011           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
2012    
2013           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)
2014           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
2015    
2016           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)
2017           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
2018    
2019           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)
2020           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2021    
          !IM cf. AM 081204 END  
   
2022           ! Champs 3D:           ! Champs 3D:
2023    
2024           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)
2025           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
2026    
2027           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)
2028           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
2029    
2030           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)
2031           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
2032    
2033           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)
2034           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2035    
2036           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), play, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
2037           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2038    
2039           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)
2040           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2041    
2042           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)
2043           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2044    
2045           if (ok_sync) then           if (ok_sync) then
# Line 2137  contains Line 2063  contains
2063    
2064        ! Champs 3D:        ! Champs 3D:
2065    
2066        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)
2067        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2068    
2069        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)
2070        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2071    
2072        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)
2073        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2074    
2075        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)
2076        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2077    
2078        if (nbtr >= 3) then        if (nbtr >= 3) then
2079           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), &
2080                zx_tmp_3d)                zx_tmp_3d)
2081           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2082        end if        end if
Legend:
Removed from v.47  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.21