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

Diff of /trunk/phylmd/physiq.f

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

revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC revision 51 by guez, Tue Sep 20 09:14:34 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 clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
18           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
20           cycle_diurne, new_oliq, soil_model           ok_orodr, ok_orolf, soil_model
21      use clmain_m, only: clmain      USE clmain_m, ONLY: clmain
22      use comgeomphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
23      use concvl_m, only: concvl      USE concvl_m, ONLY: concvl
24      use conf_gcm_m, only: raz_date, offline      USE conf_gcm_m, ONLY: offline, raz_date
25      use conf_phys_m, only: conf_phys      USE conf_phys_m, ONLY: conf_phys
26      use ctherm      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
27      use dimens_m, only: jjm, iim, llm, nqmx      use diagetpq_m, only: diagetpq
28      use dimphy, only: klon, nbtr      USE dimens_m, ONLY: iim, jjm, llm, nqmx
29      use dimsoil, only: nsoilmx      USE dimphy, ONLY: klon, nbtr
30      use hgardfou_m, only: hgardfou      USE dimsoil, ONLY: nsoilmx
31      USE histcom, only: histsync      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
32      USE histwrite_m, only: histwrite      USE hgardfou_m, ONLY: hgardfou
33      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      USE histcom, ONLY: histsync
34      use ini_histhf_m, only: ini_histhf      USE histwrite_m, ONLY: histwrite
35      use ini_histday_m, only: ini_histday      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
36      use ini_histins_m, only: ini_histins           nbsrf
37      use iniprint, only: prt_level      USE ini_histhf_m, ONLY: ini_histhf
38      use oasis_m      USE ini_histday_m, ONLY: ini_histday
39      use orbite_m, only: orbite, zenang      USE ini_histins_m, ONLY: ini_histins
40      use ozonecm_m, only: ozonecm      USE oasis_m, ONLY: ok_oasis
41      use phyetat0_m, only: phyetat0, rlat, rlon      USE orbite_m, ONLY: orbite, zenang
42      use phyredem_m, only: phyredem      USE ozonecm_m, ONLY: ozonecm
43      use phystokenc_m, only: phystokenc      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
44      use phytrac_m, only: phytrac      USE phyredem_m, ONLY: phyredem
45      use qcheck_m, only: qcheck      USE phystokenc_m, ONLY: phystokenc
46      use radepsi      USE phytrac_m, ONLY: phytrac
47      use radopt      USE qcheck_m, ONLY: qcheck
48      use temps, only: itau_phy, day_ref, annee_ref      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
49      use yoethf_m      USE temps, ONLY: annee_ref, day_ref, itau_phy
50      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE yoethf_m, ONLY: r2es, rvtmp2
51    
52      ! Declaration des constantes et des fonctions thermodynamiques :      ! Arguments:
     use fcttre, only: thermcep, foeew, qsats, qsatl  
   
     ! Variables argument:  
53    
54      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
55      ! (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 58  contains
58      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
59      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
60    
61      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
62      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
63    
64      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 70  contains Line 67  contains
67      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
68      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
69    
70      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
71    
72      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
73      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
74        
75      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
76      REAL t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
77    
78      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
79      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
# Line 84  contains Line 81  contains
81      REAL omega(klon, llm) ! input vitesse verticale en Pa/s      REAL omega(klon, llm) ! input vitesse verticale en Pa/s
82      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)
83      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)
84      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)
85      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)
86      REAL d_ps(klon) ! output tendance physique de la pression au sol      REAL d_ps(klon) ! output tendance physique de la pression au sol
87    
88      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
89    
90      INTEGER nbteta      INTEGER nbteta
91      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
92    
93      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
94      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
95    
96      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
97      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
98      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
99      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
100    
101      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
102      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
103      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
104      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
105        ! Ajouter artificiellement les stratus
106    
107      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
108      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
109      logical rnpb      logical rnpb
110      parameter(rnpb=.true.)      parameter(rnpb = .true.)
111    
112      character(len=6), save:: ocean      character(len = 6), save:: ocean
113      ! (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")
114    
115      logical ok_ocean      logical ok_ocean
116      SAVE ok_ocean      SAVE ok_ocean
117    
118      !IM "slab" ocean      ! "slab" ocean
119      REAL tslab(klon) !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
120      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
121      REAL seaice(klon) !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
122      SAVE seaice      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxo(klon) !flux turbulents ocean-glace de mer  
     REAL fluxg(klon) !flux turbulents ocean-atmosphere  
123    
124      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
125      logical, save:: ok_veget      logical, save:: ok_veget
# Line 135  contains Line 131  contains
131      save ok_instan      save ok_instan
132    
133      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
134      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
135    
136      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
137      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
138      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
139      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
140    
141      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
142      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
143      INTEGER iliq ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
144      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
145    
146      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
147      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
148    
149      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
150      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)
# Line 159  contains Line 153  contains
153    
154      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
155    
156      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
157      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
158      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
159      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 167  contains Line 161  contains
161      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
162    
163      INTEGER klevp1      INTEGER klevp1
164      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
165    
166      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
167      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
# Line 181  contains Line 175  contains
175      ! variables a une pression donnee      ! variables a une pression donnee
176    
177      integer nlevSTD      integer nlevSTD
178      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
179      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
180      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
181           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
182           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
183      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
184      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
185           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
186           '70 ', '50 ', '30 ', '20 ', '10 '/           '70 ', '50 ', '30 ', '20 ', '10 '/
# Line 200  contains Line 194  contains
194      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
195    
196      INTEGER kmax, lmax      INTEGER kmax, lmax
197      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
198      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
199      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
200    
201      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
202      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
# Line 213  contains Line 207  contains
207      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
208    
209      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
210      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
211    
212      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
213      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
214      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
215    
216      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
217      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
218           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
219           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 262  contains Line 256  contains
256    
257      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
258    
259      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol ! temperature du sol  
260    
261      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
262      SAVE ftsoil ! temperature dans le sol      ! soil temperature of surface fraction
263    
264      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
265      SAVE fevap ! evaporation      SAVE fevap ! evaporation
# Line 276  contains Line 269  contains
269      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
270      SAVE fqsurf ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
271    
272      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol ! hauteur d'eau dans le sol  
273    
274      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
275      SAVE fsnow ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
# Line 444  contains Line 436  contains
436      SAVE itaprad      SAVE itaprad
437    
438      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
439      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
440    
441      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
442      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 459  contains Line 451  contains
451      LOGICAL zx_ajustq      LOGICAL zx_ajustq
452    
453      REAL za, zb      REAL za, zb
454      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
455      real zqsat(klon, llm)      real zqsat(klon, llm)
456      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
457      REAL t_coup      REAL t_coup
458      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
459    
460      REAL zphi(klon, llm)      REAL zphi(klon, llm)
461    
462      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
463    
464      REAL pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
465      REAL plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
466      REAL capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
467      REAL oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
468      REAL cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
469      REAL pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
470      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
471      REAL trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
472      REAL trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
473      REAL trmb3(klon, nbsrf) ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
474      ! Grdeurs de sorties      ! Grdeurs de sorties
475      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
476      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
# Line 508  contains Line 500  contains
500      ! Variables du changement      ! Variables du changement
501    
502      ! con: convection      ! con: convection
503      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
504      ! ajs: ajustement sec      ! ajs: ajustement sec
505      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
506      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
507      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
508      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
509      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
# Line 523  contains Line 515  contains
515      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
516      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
517      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
518      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
519      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
520    
521      INTEGER ibas_con(klon), itop_con(klon)      INTEGER,save:: ibas_con(klon), itop_con(klon)
   
     SAVE ibas_con, itop_con  
522    
523      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
524      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 558  contains Line 548  contains
548    
549      logical ptconv(klon, llm)      logical ptconv(klon, llm)
550    
551      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en série :
552    
553      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
554      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 574  contains Line 564  contains
564      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
565      REAL aam, torsfc      REAL aam, torsfc
566    
567      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
568    
569      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
570      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)      REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
# Line 588  contains Line 578  contains
578    
579      REAL zsto      REAL zsto
580    
581      character(len=20) modname      character(len = 20) modname
582      character(len=80) abort_message      character(len = 80) abort_message
583      logical ok_sync      logical ok_sync
584      real date0      real date0
585    
586      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
587      REAL ztsol(klon)      REAL ztsol(klon)
588      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
589      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
590      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
     SAVE d_h_vcol_phy  
591      REAL zero_v(klon)      REAL zero_v(klon)
592      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) ztit
593      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/  
594      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
595      !+jld ec_conser  
596      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
597      REAL ZRCPD      REAL ZRCPD
598      !-jld ec_conser  
599      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) !temperature, humidite a 2m  
600      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
601      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
602      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
603      !jq Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
604      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
605    
606      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
607      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
608    
609      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
610      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
# Line 632  contains Line 617  contains
617      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
618    
619      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
620      ! ok_ade=T -ADE=topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
621    
622      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
623      ! ok_aie=T ->      ! ok_aie = True ->
624      ! ok_ade=T -AIE=topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
625      ! ok_ade=F -AIE=topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
626    
627      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
628    
# Line 665  contains Line 650  contains
650      SAVE d_v_con      SAVE d_v_con
651      SAVE rnebcon0      SAVE rnebcon0
652      SAVE clwcon0      SAVE clwcon0
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
653    
654      real zmasse(klon, llm)      real zmasse(klon, llm)
655      ! (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 660  contains
660    
661      modname = 'physiq'      modname = 'physiq'
662      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
663         DO i=1, klon         DO i = 1, klon
664            zero_v(i)=0.            zero_v(i) = 0.
665         END DO         END DO
666      END IF      END IF
667      ok_sync=.TRUE.      ok_sync = .TRUE.
668      IF (nqmx < 2) THEN      IF (nqmx < 2) THEN
669         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
670         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
# Line 697  contains Line 672  contains
672    
673      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
674         ! initialiser         ! initialiser
675         u10m=0.         u10m = 0.
676         v10m=0.         v10m = 0.
677         t2m=0.         t2m = 0.
678         q2m=0.         q2m = 0.
679         ffonte=0.         ffonte = 0.
680         fqcalving=0.         fqcalving = 0.
681         piz_ae=0.         piz_ae = 0.
682         tau_ae=0.         tau_ae = 0.
683         cg_ae=0.         cg_ae = 0.
684         rain_con(:)=0.         rain_con(:) = 0.
685         snow_con(:)=0.         snow_con(:) = 0.
686         bl95_b0=0.         bl95_b0 = 0.
687         bl95_b1=0.         bl95_b1 = 0.
688         topswai(:)=0.         topswai(:) = 0.
689         topswad(:)=0.         topswad(:) = 0.
690         solswai(:)=0.         solswai(:) = 0.
691         solswad(:)=0.         solswad(:) = 0.
692    
693         d_u_con = 0.0         d_u_con = 0.0
694         d_v_con = 0.0         d_v_con = 0.0
# Line 733  contains Line 708  contains
708         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
709         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
710    
711         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
712    
713         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
714    
# Line 750  contains Line 725  contains
725         itap = 0         itap = 0
726         itaprad = 0         itaprad = 0
727         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
728              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
729              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
730              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
731              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)  
732    
733         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
734         q2=1.e-8         q2 = 1.e-8
735    
736         radpas = NINT( 86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
737    
738         ! on remet le calendrier a zero         ! on remet le calendrier a zero
739         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 768  contains Line 741  contains
741         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
742    
743         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
744            ok_ocean=.TRUE.            ok_ocean = .TRUE.
745         ENDIF         ENDIF
746    
747         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
748              ok_region)              ok_region)
749    
750         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
751            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
752            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
753            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
754            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
755         ENDIF         ENDIF
756         print *,"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con = ", iflag_con
757         print *,"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl = ", &
758              ok_cvl              ok_cvl
759    
760         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
# Line 819  contains Line 792  contains
792         npas = 0         npas = 0
793         nexca = 0         nexca = 0
794    
795         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
796    
797         ! Initialisation des sorties         ! Initialisation des sorties
798    
# Line 828  contains Line 801  contains
801         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
802         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
803         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
804         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
805      ENDIF test_firstcal      ENDIF test_firstcal
806    
807      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 836  contains Line 809  contains
809      DO i = 1, klon      DO i = 1, klon
810         d_ps(i) = 0.0         d_ps(i) = 0.0
811      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  
812      DO iq = 1, nqmx      DO iq = 1, nqmx
813         DO k = 1, llm         DO k = 1, llm
814            DO i = 1, klon            DO i = 1, klon
# Line 850  contains Line 816  contains
816            ENDDO            ENDDO
817         ENDDO         ENDDO
818      ENDDO      ENDDO
819      da=0.      da = 0.
820      mp=0.      mp = 0.
821      phi=0.      phi = 0.
822    
823      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrées de u, v, h, et q :
824    
825      DO k = 1, llm      DO k = 1, llm
826         DO i = 1, klon         DO i = 1, klon
# Line 882  contains Line 848  contains
848      ENDDO      ENDDO
849    
850      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
851         ztit='after dynamic'         ztit = 'after dynamics'
852         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
853              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, &
854              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
855         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
856         ! on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
857         ! est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
858         ! Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
859           !  nulle.
860         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, &
861              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, &
862              d_qt, 0., fs_bound, fq_bound )              d_qt, 0., fs_bound, fq_bound)
863      END IF      END IF
864    
865      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
866      IF (ancien_ok) THEN      IF (ancien_ok) THEN
867         DO k = 1, llm         DO k = 1, llm
868            DO i = 1, klon            DO i = 1, klon
869               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtphys               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
870               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtphys               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
871            ENDDO            ENDDO
872         ENDDO         ENDDO
873      ELSE      ELSE
# Line 915  contains Line 881  contains
881      ENDIF      ENDIF
882    
883      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
884      DO k = 1, llm      DO k = 1, llm
885         DO i = 1, klon         DO i = 1, klon
886            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
887         ENDDO         ENDDO
888      ENDDO      ENDDO
889    
890      ! Verifier les temperatures      ! Check temperatures:
   
891      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
892    
893      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
894      itap = itap + 1      itap = itap + 1
895      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
896      if (julien == 0) julien = 360      if (julien == 0) julien = 360
897    
898      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
899    
900      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
901    
902        ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
903      if (nqmx >= 5) then      if (nqmx >= 5) then
904         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
905      else IF (MOD(itap - 1, lmt_pas) == 0) THEN      else IF (MOD(itap - 1, lmt_pas) == 0) THEN
906         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
907      ENDIF      ENDIF
908    
909      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
910        DO k = 1, llm
     DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse  
911         DO i = 1, klon         DO i = 1, klon
912            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
913            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
914            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
915            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
916         ENDDO         ENDDO
917      ENDDO      ENDDO
918        ql_seri = 0.
919    
920      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
921         ztit='after reevap'         ztit = 'after reevap'
922         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
923              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, &
924              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
925         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, &
926              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, &
927              fs_bound, fq_bound )              fs_bound, fq_bound)
928    
929      END IF      END IF
930    
# Line 997  contains Line 955  contains
955      ENDIF      ENDIF
956    
957      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
958      albsol(:)=0.      albsol(:) = 0.
959      albsollw(:)=0.      albsollw(:) = 0.
960      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
961         DO i = 1, klon         DO i = 1, klon
962            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1034  contains Line 992  contains
992    
993      ! Incrémentation des flux      ! Incrémentation des flux
994    
995      zxfluxt=0.      zxfluxt = 0.
996      zxfluxq=0.      zxfluxq = 0.
997      zxfluxu=0.      zxfluxu = 0.
998      zxfluxv=0.      zxfluxv = 0.
999      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1000         DO k = 1, llm         DO k = 1, llm
1001            DO i = 1, klon            DO i = 1, klon
1002               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + &
1003                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1004               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxq(i, k) = zxfluxq(i, k) + &
1005                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1006               zxfluxu(i, k) = zxfluxu(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + &
1007                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1008               zxfluxv(i, k) = zxfluxv(i, k) + &               zxfluxv(i, k) = zxfluxv(i, k) + &
1009                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1010            END DO            END DO
1011         END DO         END DO
1012      END DO      END DO
# Line 1068  contains Line 1026  contains
1026      ENDDO      ENDDO
1027    
1028      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1029         ztit='after clmain'         ztit = 'after clmain'
1030         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1031              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, &
1032              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1033         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, &
1034              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, &
1035              fs_bound, fq_bound )              fs_bound, fq_bound)
1036      END IF      END IF
1037    
1038      ! Incrementer la temperature du sol      ! Update surface temperature:
1039    
1040      DO i = 1, klon      DO i = 1, klon
1041         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1101  contains Line 1059  contains
1059         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1060         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1061    
1062         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1063              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1064              THEN              THEN
1065            WRITE(*, *) 'physiq : pb sous surface au point ', i, &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1066                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
# Line 1147  contains Line 1105  contains
1105            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1106            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
1107                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1108            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1109            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1110            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1111            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1112            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1113            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1114            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1115            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1116            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1117            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1118         ENDDO         ENDDO
1119      ENDDO      ENDDO
1120    
# Line 1178  contains Line 1136  contains
1136      ENDDO      ENDDO
1137      IF (check) THEN      IF (check) THEN
1138         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1139         print *, "avantcon=", za         print *, "avantcon = ", za
1140      ENDIF      ENDIF
1141      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1142      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1143      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1144         DO i = 1, klon         DO i = 1, klon
1145            z_avant(i) = 0.0            z_avant(i) = 0.0
1146         ENDDO         ENDDO
1147         DO k = 1, llm         DO k = 1, llm
1148            DO i = 1, klon            DO i = 1, klon
1149               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &
1150                    *zmasse(i, k)                    *zmasse(i, k)
1151            ENDDO            ENDDO
1152         ENDDO         ENDDO
1153      ENDIF      ENDIF
1154      IF (iflag_con == 1) THEN  
1155         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1156      ELSE IF (iflag_con == 2) THEN      case (1)
1157         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1158              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1159              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1160              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1161              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1162                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1163                pmflxs)
1164         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1165         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1166         DO i = 1, klon         DO i = 1, klon
1167            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1168            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1169         ENDDO         ENDDO
1170      ELSE IF (iflag_con >= 3) THEN      case (3:)
1171         ! nb of tracers for the KE convection:         ! number of tracers for the Kerry-Emanuel convection:
1172         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1173         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1174         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1175         ntra = 1         ntra = 1
1176         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1177         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1178    
1179         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1180              ! new driver for convectL
1181            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1182                 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, &
1183                 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, &
1184                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1185                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1186                 pmflxs, da, phi, mp)                 pmflxs, da, phi, mp)
1187              clwcon0 = qcondc
1188            clwcon0=qcondc            pmfu = upwd + dnwd
           pmfu=upwd+dnwd  
1189         ELSE         ELSE
1190            ! MAF conema3 ne contient pas les traceurs            ! conema3 ne contient pas les traceurs
1191            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1192                 u_seri, v_seri, tr_seri, ntra, &                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1193                 ema_work1, ema_work2, &                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1194                 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, &
1195                 rain_con, snow_con, ibas_con, itop_con, &                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1196                 upwd, dnwd, dnwd0, bas, top, &         ENDIF
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
1197    
1198         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1199            do i = 1, klon            do i = 1, klon
1200               wd(i)=0.0               wd(i) = 0.0
1201            enddo            enddo
1202         ENDIF         ENDIF
1203    
1204         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1205    
1206         DO k = 1, llm         DO k = 1, llm
1207            DO i = 1, klon            DO i = 1, klon
# Line 1264  contains Line 1219  contains
1219                     zx_qs = qsatl(zx_t)/play(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1220                  ENDIF                  ENDIF
1221               ENDIF               ENDIF
1222               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1223            ENDDO            ENDDO
1224         ENDDO         ENDDO
1225    
1226         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1227         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1228         call clouds_gno &         call clouds_gno &
1229              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1230      ELSE      case default
1231         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1232         stop 1         stop 1
1233      ENDIF      END select
1234    
1235      DO k = 1, llm      DO k = 1, llm
1236         DO i = 1, klon         DO i = 1, klon
# Line 1287  contains Line 1242  contains
1242      ENDDO      ENDDO
1243    
1244      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1245         ztit='after convect'         ztit = 'after convect'
1246         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1247              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, &
1248              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1249         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, &
1250              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, &
1251              fs_bound, fq_bound )              fs_bound, fq_bound)
1252      END IF      END IF
1253    
1254      IF (check) THEN      IF (check) THEN
1255         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1256         print *,"aprescon=", za         print *,"aprescon = ", za
1257         zx_t = 0.0         zx_t = 0.0
1258         za = 0.0         za = 0.0
1259         DO i = 1, klon         DO i = 1, klon
# Line 1307  contains Line 1262  contains
1262                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1263         ENDDO         ENDDO
1264         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1265         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1266      ENDIF      ENDIF
1267      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1268         DO i = 1, klon         DO i = 1, klon
# Line 1315  contains Line 1270  contains
1270         ENDDO         ENDDO
1271         DO k = 1, llm         DO k = 1, llm
1272            DO i = 1, klon            DO i = 1, klon
1273               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &
1274                    *zmasse(i, k)                    *zmasse(i, k)
1275            ENDDO            ENDDO
1276         ENDDO         ENDDO
1277         DO i = 1, klon         DO i = 1, klon
1278            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1279                 /z_apres(i)                 /z_apres(i)
1280         ENDDO         ENDDO
1281         DO k = 1, llm         DO k = 1, llm
1282            DO i = 1, klon            DO i = 1, klon
1283               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > (1.0 + 1.0E-08) .OR. &
1284                    z_factor(i) < (1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1285                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1286               ENDIF               ENDIF
1287            ENDDO            ENDDO
1288         ENDDO         ENDDO
1289      ENDIF      ENDIF
1290      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1291    
1292      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1293    
1294      d_t_ajs=0.      d_t_ajs = 0.
1295      d_u_ajs=0.      d_u_ajs = 0.
1296      d_v_ajs=0.      d_v_ajs = 0.
1297      d_q_ajs=0.      d_q_ajs = 0.
1298      fm_therm=0.      fm_therm = 0.
1299      entr_therm=0.      entr_therm = 0.
1300    
1301      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1302         ! Ajustement sec         ! Ajustement sec
# Line 1355  contains Line 1310  contains
1310      endif      endif
1311    
1312      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1313         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1314         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1315              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, &
1316              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1363  contains Line 1318  contains
1318    
1319      ! Caclul des ratqs      ! Caclul des ratqs
1320    
1321      ! ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q
1322      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1323      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1324         do k=1, llm         do k = 1, llm
1325            do i=1, klon            do i = 1, klon
1326               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1327                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1328                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1329               else               else
1330                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1331               endif               endif
1332            enddo            enddo
1333         enddo         enddo
1334      endif      endif
1335    
1336      ! ratqs stables      ! ratqs stables
1337      do k=1, llm      do k = 1, llm
1338         do i=1, klon         do i = 1, klon
1339            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1340                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1341         enddo         enddo
1342      enddo      enddo
# Line 1392  contains Line 1347  contains
1347         ! ratqs final         ! ratqs final
1348         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1349         ! relaxation des ratqs         ! relaxation des ratqs
1350         facteur=exp(-dtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1351         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1352         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1353      else      else
1354         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1355         ratqs=ratqss         ratqs = ratqss
1356      endif      endif
1357    
1358      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1359      ! et le processus de precipitation      ! précipitation :
1360      CALL fisrtilp(dtphys, paprs, play, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1361           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1362           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1363           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1364    
1365      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1366      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1423  contains Line 1375  contains
1375      ENDDO      ENDDO
1376      IF (check) THEN      IF (check) THEN
1377         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1378         print *,"apresilp=", za         print *,"apresilp = ", za
1379         zx_t = 0.0         zx_t = 0.0
1380         za = 0.0         za = 0.0
1381         DO i = 1, klon         DO i = 1, klon
# Line 1432  contains Line 1384  contains
1384                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1385         ENDDO         ENDDO
1386         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1387         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1388      ENDIF      ENDIF
1389    
1390      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1391         ztit='after fisrt'         ztit = 'after fisrt'
1392         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1393              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, &
1394              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1395         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, &
1396              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, &
1397              fs_bound, fq_bound )              fs_bound, fq_bound)
1398      END IF      END IF
1399    
1400      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
# Line 1450  contains Line 1402  contains
1402      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1403    
1404      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1405         snow_tiedtke=0.         snow_tiedtke = 0.
1406         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1407            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1408         else         else
1409            rain_tiedtke=0.            rain_tiedtke = 0.
1410            do k=1, llm            do k = 1, llm
1411               do i=1, klon               do i = 1, klon
1412                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1413                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1414                          *zmasse(i, k)                          *zmasse(i, k)
1415                  endif                  endif
1416               enddo               enddo
# Line 1471  contains Line 1423  contains
1423              diafra, dialiq)              diafra, dialiq)
1424         DO k = 1, llm         DO k = 1, llm
1425            DO i = 1, klon            DO i = 1, klon
1426               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1427                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1428                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1429               ENDIF               ENDIF
1430            ENDDO            ENDDO
1431         ENDDO         ENDDO
   
1432      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1433         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1434         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1435         ! facttemps         ! facttemps
1436         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1437         do k=1, llm         do k = 1, llm
1438            do i=1, klon            do i = 1, klon
1439               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1440               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1441                    then                    then
1442                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1443                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1444               endif               endif
1445            enddo            enddo
1446         enddo         enddo
1447    
1448         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1449         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1450         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1451      ENDIF      ENDIF
1452    
1453      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1454    
1455      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1456         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1457         DO k = 1, llm         DO k = 1, llm
1458            DO i = 1, klon            DO i = 1, klon
1459               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1460                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1461                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1462               ENDIF               ENDIF
# Line 1522  contains Line 1472  contains
1472      ENDDO      ENDDO
1473    
1474      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1475         ztit="after diagcld"         ztit = "after diagcld"
1476         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1477              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, &
1478              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1547  contains Line 1497  contains
1497               ENDIF               ENDIF
1498            ENDIF            ENDIF
1499            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1500            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1501         ENDDO         ENDDO
1502      ENDDO      ENDDO
1503      !jq - introduce the aerosol direct and first indirect radiative forcings      !jq - introduce the aerosol direct and first indirect radiative forcings
# Line 1561  contains Line 1511  contains
1511         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &
1512              tau_ae, piz_ae, cg_ae, aerindex)              tau_ae, piz_ae, cg_ae, aerindex)
1513      ELSE      ELSE
1514         tau_ae=0.0         tau_ae = 0.0
1515         piz_ae=0.0         piz_ae = 0.0
1516         cg_ae=0.0         cg_ae = 0.0
1517      ENDIF      ENDIF
1518    
1519      ! Calculer les parametres optiques des nuages et quelques      ! Calculer les parametres optiques des nuages et quelques
# Line 1623  contains Line 1573  contains
1573      ENDDO      ENDDO
1574    
1575      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1576         ztit='after rad'         ztit = 'after rad'
1577         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1578              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, &
1579              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1580         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1581              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, &
1582              fs_bound, fq_bound )              fs_bound, fq_bound)
1583      END IF      END IF
1584    
1585      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1586      DO i = 1, klon      DO i = 1, klon
1587         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1588         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1645  contains Line 1594  contains
1594         ENDDO         ENDDO
1595      ENDDO      ENDDO
1596    
1597      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1598    
1599      DO i = 1, klon      DO i = 1, klon
1600         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1601      ENDDO      ENDDO
1602    
1603      !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:  
1604    
1605      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1606         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1607         igwd=0         igwd = 0
1608         DO i=1, klon         DO i = 1, klon
1609            itest(i)=0            itest(i) = 0
1610            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
1611               itest(i)=1               itest(i) = 1
1612               igwd=igwd+1               igwd = igwd + 1
1613               idx(igwd)=i               idx(igwd) = i
1614            ENDIF            ENDIF
1615         ENDDO         ENDDO
1616    
1617         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1618              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1619              igwd, idx, itest, &              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1620    
1621         ! ajout des tendances         ! ajout des tendances
1622         DO k = 1, llm         DO k = 1, llm
# Line 1685  contains Line 1629  contains
1629      ENDIF      ENDIF
1630    
1631      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1632           ! Sélection des points pour lesquels le schéma est actif :
1633         ! selection des points pour lesquels le shema est actif:         igwd = 0
1634         igwd=0         DO i = 1, klon
1635         DO i=1, klon            itest(i) = 0
1636            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1637            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1638               itest(i)=1               igwd = igwd + 1
1639               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1640            ENDIF            ENDIF
1641         ENDDO         ENDDO
1642    
# Line 1701  contains Line 1644  contains
1644              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1645              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1646    
1647         ! ajout des tendances         ! Ajout des tendances :
1648         DO k = 1, llm         DO k = 1, llm
1649            DO i = 1, klon            DO i = 1, klon
1650               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1709  contains Line 1652  contains
1652               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
1653            ENDDO            ENDDO
1654         ENDDO         ENDDO
1655        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1656    
1657      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1658    
1659      DO i = 1, klon      DO i = 1, klon
1660         zustrph(i)=0.         zustrph(i) = 0.
1661         zvstrph(i)=0.         zvstrph(i) = 0.
1662      ENDDO      ENDDO
1663      DO k = 1, llm      DO k = 1, llm
1664         DO i = 1, klon         DO i = 1, klon
1665            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1666            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)
1667         ENDDO         ENDDO
1668      ENDDO      ENDDO
1669    
# Line 1732  contains Line 1674  contains
1674           aam, torsfc)           aam, torsfc)
1675    
1676      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1677         ztit='after orography'         ztit = 'after orography'
1678         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1679              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, &
1680              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1763  contains Line 1705  contains
1705    
1706      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1707    
1708      !+jld ec_conser      ! conversion Ec -> E thermique
1709      DO k = 1, llm      DO k = 1, llm
1710         DO i = 1, klon         DO i = 1, klon
1711            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1712            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1713                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
1714            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
1715            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1716         END DO         END DO
1717      END DO      END DO
1718      !-jld ec_conser  
1719      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1720         ztit='after physic'         ztit = 'after physic'
1721         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1722              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, &
1723              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1785  contains Line 1727  contains
1727         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1728         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1729              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, &
1730              fs_bound, fq_bound )              fs_bound, fq_bound)
1731    
1732         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1733    
1734      END IF      END IF
1735    
# Line 1805  contains Line 1747  contains
1747    
1748      DO k = 1, llm      DO k = 1, llm
1749         DO i = 1, klon         DO i = 1, klon
1750            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1751            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1752            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1753            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1754            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1755         ENDDO         ENDDO
1756      ENDDO      ENDDO
1757    
# Line 1839  contains Line 1781  contains
1781      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1782      IF (lafin) THEN      IF (lafin) THEN
1783         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1784         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1785              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1786              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1787              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1788              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)  
1789      ENDIF      ENDIF
1790    
1791      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1981  contains Line 1921  contains
1921           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)
1922           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1923    
1924           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1925           ! CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)
1926           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1927           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
# Line 2003  contains Line 1943  contains
1943    
1944           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1945              !XXX              !XXX
1946              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1947              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1948              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1949                   zx_tmp_2d)                   zx_tmp_2d)
1950    
1951              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1952              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1953              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1954                   zx_tmp_2d)                   zx_tmp_2d)
1955    
1956              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1957              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1958              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1959                   zx_tmp_2d)                   zx_tmp_2d)
1960    
1961              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1962              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1963              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1964                   zx_tmp_2d)                   zx_tmp_2d)
1965    
1966              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1967              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1968              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1969                   zx_tmp_2d)                   zx_tmp_2d)
1970    
1971              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1972              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1973              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1974                   zx_tmp_2d)                   zx_tmp_2d)
1975    
1976              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1977              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1978              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1979                   zx_tmp_2d)                   zx_tmp_2d)
1980    
1981              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1982              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1983              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1984                   zx_tmp_2d)                   zx_tmp_2d)
1985    
1986              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1987              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
1988              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1989                   zx_tmp_2d)                   zx_tmp_2d)
# Line 2057  contains Line 1997  contains
1997           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)
1998           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1999    
          !IM cf. AM 081204 BEG  
   
2000           !HBTM2           !HBTM2
2001    
2002           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)
# Line 2091  contains Line 2029  contains
2029           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)
2030           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2031    
          !IM cf. AM 081204 END  
   
2032           ! Champs 3D:           ! Champs 3D:
2033    
2034           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)
Legend:
Removed from v.47  
changed lines
  Added in v.51
  ViewVC Help
Powered by ViewVC 1.1.21