/[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 49 by guez, Wed Aug 24 11:43:14 2011 UTC revision 56 by guez, Tue Jan 10 19:02:02 2012 UTC
# Line 12  contains Line 12  contains
12    
13      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
14    
15      use abort_gcm_m, only: abort_gcm      use aaam_bud_m, only: aaam_bud
16      USE calendar, only: ymds2ju      USE abort_gcm_m, ONLY: abort_gcm
17      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, cdmmax, cdhmax, &      use ajsec_m, only: ajsec
18           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      USE calendar, ONLY: ymds2ju
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use calltherm_m, only: calltherm
20           cycle_diurne, new_oliq, soil_model      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
21      use clmain_m, only: clmain           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
22      use comgeomphy      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
23      use concvl_m, only: concvl           ok_orodr, ok_orolf, soil_model
24      use conf_gcm_m, only: raz_date, offline      USE clmain_m, ONLY: clmain
25      use conf_phys_m, only: conf_phys      USE comgeomphy, ONLY: airephy, cuphy, cvphy
26      use ctherm      USE concvl_m, ONLY: concvl
27      use dimens_m, only: jjm, iim, llm, nqmx      USE conf_gcm_m, ONLY: offline, raz_date
28      use dimphy, only: klon, nbtr      USE conf_phys_m, ONLY: conf_phys
29      use dimsoil, only: nsoilmx      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
30      use fcttre, only: thermcep, foeew, qsats, qsatl      use diagcld2_m, only: diagcld2
31      use hgardfou_m, only: hgardfou      use diagetpq_m, only: diagetpq
32      USE histcom, only: histsync      USE dimens_m, ONLY: iim, jjm, llm, nqmx
33      USE histwrite_m, only: histwrite      USE dimphy, ONLY: klon, nbtr
34      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      USE dimsoil, ONLY: nsoilmx
35      use ini_histhf_m, only: ini_histhf      use drag_noro_m, only: drag_noro
36      use ini_histday_m, only: ini_histday      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
37      use ini_histins_m, only: ini_histins      USE hgardfou_m, ONLY: hgardfou
38      use iniprint, only: prt_level      USE histcom, ONLY: histsync
39      use oasis_m      USE histwrite_m, ONLY: histwrite
40      use orbite_m, only: orbite, zenang      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
41      use ozonecm_m, only: ozonecm           nbsrf
42      use phyetat0_m, only: phyetat0, rlat, rlon      USE ini_histhf_m, ONLY: ini_histhf
43      use phyredem_m, only: phyredem      USE ini_histday_m, ONLY: ini_histday
44      use phystokenc_m, only: phystokenc      USE ini_histins_m, ONLY: ini_histins
45      use phytrac_m, only: phytrac      USE oasis_m, ONLY: ok_oasis
46      use qcheck_m, only: qcheck      USE orbite_m, ONLY: orbite, zenang
47      use radepsi      USE ozonecm_m, ONLY: ozonecm
48      use radopt      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
49      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE phyredem_m, ONLY: phyredem
50      use temps, only: itau_phy, day_ref, annee_ref      USE phystokenc_m, ONLY: phystokenc
51      use yoethf_m      USE phytrac_m, ONLY: phytrac
52        USE qcheck_m, ONLY: qcheck
53        use radlwsw_m, only: radlwsw
54        use sugwd_m, only: sugwd
55        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
56        USE temps, ONLY: annee_ref, day_ref, itau_phy
57        USE yoethf_m, ONLY: r2es, rvtmp2
58    
59      ! Variables argument:      ! Arguments:
60    
61      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
62      ! (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 59  contains Line 65  contains
65      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
66      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
67    
68      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
69      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
70    
71      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 68  contains Line 74  contains
74      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
75      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
76    
77      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
78    
79      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
80      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
81        
82      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
83      REAL t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
84    
85      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
86      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
# Line 89  contains Line 95  contains
95      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
96    
97      INTEGER nbteta      INTEGER nbteta
98      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
99    
100      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
101      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
102    
103      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
104      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
105      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
106      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
107    
108      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
109      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
110    
111      LOGICAL, PARAMETER:: ok_stratus=.FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
112      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
113    
114      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
115      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
116      logical rnpb      logical rnpb
117      parameter(rnpb=.true.)      parameter(rnpb = .true.)
118    
119      character(len=6), save:: ocean      character(len = 6), save:: ocean
120      ! (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")
121    
122      logical ok_ocean      logical ok_ocean
# Line 132  contains Line 138  contains
138      save ok_instan      save ok_instan
139    
140      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
141      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
142    
143      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
144      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
145      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
146      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
147    
148      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
149      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
150      INTEGER iliq ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
151      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
152    
153      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
154      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
# Line 154  contains Line 160  contains
160    
161      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
162    
163      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
164      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
165      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
166      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 162  contains Line 168  contains
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      INTEGER klevp1
171      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
172    
173      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
174      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
# Line 176  contains Line 182  contains
182      ! variables a une pression donnee      ! variables a une pression donnee
183    
184      integer nlevSTD      integer nlevSTD
185      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
186      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
187      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
188           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
189           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
190      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
191      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
192           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
193           '70 ', '50 ', '30 ', '20 ', '10 '/           '70 ', '50 ', '30 ', '20 ', '10 '/
# Line 195  contains Line 201  contains
201      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
202    
203      INTEGER kmax, lmax      INTEGER kmax, lmax
204      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
205      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
206      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
207    
208      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
209      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 208  contains Line 214  contains
214      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
215    
216      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
217      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
218    
219      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
220      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
221      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
222    
223      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
224      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', &
225           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
226           '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 385  contains Line 391  contains
391      ! Declaration des procedures appelees      ! Declaration des procedures appelees
392    
393      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec ! ajustement sec  
394      !KE43      !KE43
395      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
396      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
397      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
     EXTERNAL radlwsw ! rayonnements solaire et infrarouge  
398      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
399    
400      ! Variables locales      ! Variables locales
# Line 418  contains Line 422  contains
422      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
423      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
424    
425      REAL heat(klon, llm) ! chauffage solaire      ! Le rayonnement n'est pas calcule tous les pas, il faut donc
426        ! que les variables soient rémanentes
427        REAL, save:: heat(klon, llm) ! chauffage solaire
428      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
429      REAL cool(klon, llm) ! refroidissement infrarouge      REAL cool(klon, llm) ! refroidissement infrarouge
430      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
# Line 428  contains Line 434  contains
434      REAL albpla(klon)      REAL albpla(klon)
435      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
436      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
437      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE cool, albpla, topsw, toplw, solsw, sollw, sollwdown
     ! sauvegarder les sorties du rayonnement  
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
438      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0      SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0
439    
440      INTEGER itaprad      INTEGER itaprad
# Line 452  contains Line 456  contains
456      LOGICAL zx_ajustq      LOGICAL zx_ajustq
457    
458      REAL za, zb      REAL za, zb
459      REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp      REAL zx_t, zx_qs, zdelta, zcor
460      real zqsat(klon, llm)      real zqsat(klon, llm)
461      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
462      REAL t_coup      REAL t_coup
463      PARAMETER (t_coup=234.0)      PARAMETER (t_coup = 234.0)
464    
465      REAL zphi(klon, llm)      REAL zphi(klon, llm)
466    
# Line 501  contains Line 505  contains
505      ! Variables du changement      ! Variables du changement
506    
507      ! con: convection      ! con: convection
508      ! lsc: condensation a grande echelle (Large-Scale-Condensation)      ! lsc: large scale condensation
509      ! ajs: ajustement sec      ! ajs: ajustement sec
510      ! eva: evaporation de l'eau liquide nuageuse      ! eva: évaporation de l'eau liquide nuageuse
511      ! vdf: couche limite (Vertical DiFfusion)      ! vdf: vertical diffusion in boundary layer
512      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
513      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL d_u_con(klon, llm), d_v_con(klon, llm)
514      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 516  contains Line 520  contains
520      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
521      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
522      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
523      REAL pmflxr(klon, llm+1), pmflxs(klon, llm+1)      REAL pmflxr(klon, llm + 1), pmflxs(klon, llm + 1)
524      REAL prfl(klon, llm+1), psfl(klon, llm+1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
525    
526      INTEGER ibas_con(klon), itop_con(klon)      INTEGER,save:: ibas_con(klon), itop_con(klon)
   
     SAVE ibas_con, itop_con  
527    
528      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
529      REAL snow_con(klon), snow_lsc(klon)      REAL snow_con(klon), snow_lsc(klon)
# Line 551  contains Line 553  contains
553    
554      logical ptconv(klon, llm)      logical ptconv(klon, llm)
555    
556      ! Variables locales pour effectuer les appels en série      ! Variables locales pour effectuer les appels en série :
557    
558      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
559      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 567  contains Line 569  contains
569      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
570      REAL aam, torsfc      REAL aam, torsfc
571    
572      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
573    
574      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
575      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 581  contains Line 583  contains
583    
584      REAL zsto      REAL zsto
585    
586      character(len=20) modname      character(len = 20) modname
587      character(len=80) abort_message      character(len = 80) abort_message
588      logical ok_sync      logical ok_sync
589      real date0      real date0
590    
591      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
592      REAL ztsol(klon)      REAL ztsol(klon)
593      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
594      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
595      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
     SAVE d_h_vcol_phy  
596      REAL zero_v(klon)      REAL zero_v(klon)
597      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) ztit
598      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/  
599      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
600      !+jld ec_conser  
601      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
602      REAL ZRCPD      REAL ZRCPD
603      !-jld ec_conser  
     !IM: t2m, q2m, u10m, v10m  
604      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
605      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
606      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille
# Line 624  contains Line 622  contains
622      REAL cg_ae(klon, llm, 2)      REAL cg_ae(klon, llm, 2)
623    
624      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.
625      ! ok_ade=True -ADE=topswad-topsw      ! ok_ade = True -ADE = topswad-topsw
626    
627      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.
628      ! ok_aie=True ->      ! ok_aie = True ->
629      ! ok_ade=True -AIE=topswai-topswad      ! ok_ade = True -AIE = topswai-topswad
630      ! ok_ade=F -AIE=topswai-topsw      ! ok_ade = F -AIE = topswai-topsw
631    
632      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
633    
# Line 667  contains Line 665  contains
665    
666      modname = 'physiq'      modname = 'physiq'
667      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
668         DO i=1, klon         DO i = 1, klon
669            zero_v(i)=0.            zero_v(i) = 0.
670         END DO         END DO
671      END IF      END IF
672      ok_sync=.TRUE.      ok_sync = .TRUE.
673      IF (nqmx < 2) THEN      IF (nqmx < 2) THEN
674         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
675         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
# Line 679  contains Line 677  contains
677    
678      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
679         ! initialiser         ! initialiser
680         u10m=0.         u10m = 0.
681         v10m=0.         v10m = 0.
682         t2m=0.         t2m = 0.
683         q2m=0.         q2m = 0.
684         ffonte=0.         ffonte = 0.
685         fqcalving=0.         fqcalving = 0.
686         piz_ae=0.         piz_ae = 0.
687         tau_ae=0.         tau_ae = 0.
688         cg_ae=0.         cg_ae = 0.
689         rain_con(:)=0.         rain_con(:) = 0.
690         snow_con(:)=0.         snow_con(:) = 0.
691         bl95_b0=0.         bl95_b0 = 0.
692         bl95_b1=0.         bl95_b1 = 0.
693         topswai(:)=0.         topswai(:) = 0.
694         topswad(:)=0.         topswad(:) = 0.
695         solswai(:)=0.         solswai(:) = 0.
696         solswad(:)=0.         solswad(:) = 0.
697    
698         d_u_con = 0.0         d_u_con = 0.0
699         d_v_con = 0.0         d_v_con = 0.0
# Line 715  contains Line 713  contains
713         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
714         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
715    
716         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
717    
718         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
719    
# Line 738  contains Line 736  contains
736              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
737    
738         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
739         q2=1.e-8         q2 = 1.e-8
740    
741         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
742    
# Line 748  contains Line 746  contains
746         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
747    
748         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
749            ok_ocean=.TRUE.            ok_ocean = .TRUE.
750         ENDIF         ENDIF
751    
752         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
753              ok_region)              ok_region)
754    
755         IF (dtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
756            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
757            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
758            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
759            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
760         ENDIF         ENDIF
761         print *,"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con = ", iflag_con
762         print *,"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl = ", &
763              ok_cvl              ok_cvl
764    
765         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
# Line 780  contains Line 778  contains
778    
779         IF (ok_orodr) THEN         IF (ok_orodr) THEN
780            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
781            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
782         else         else
783            rugoro = 0.            rugoro = 0.
784         ENDIF         ENDIF
# Line 799  contains Line 797  contains
797         npas = 0         npas = 0
798         nexca = 0         nexca = 0
799    
800         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
801    
802         ! Initialisation des sorties         ! Initialisation des sorties
803    
# Line 808  contains Line 806  contains
806         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
807         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
808         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
809         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
810      ENDIF test_firstcal      ENDIF test_firstcal
811    
812      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 823  contains Line 821  contains
821            ENDDO            ENDDO
822         ENDDO         ENDDO
823      ENDDO      ENDDO
824      da=0.      da = 0.
825      mp=0.      mp = 0.
826      phi=0.      phi = 0.
827    
828      ! 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 :
829    
830      DO k = 1, llm      DO k = 1, llm
831         DO i = 1, klon         DO i = 1, klon
# Line 855  contains Line 853  contains
853      ENDDO      ENDDO
854    
855      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
856         ztit='after dynamic'         ztit = 'after dynamics'
857         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, &
858              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, &
859              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
860         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
861         ! on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
862         ! est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
863         ! Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
864           !  nulle.
865         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, &
866              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, &
867              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
868      END IF      END IF
869    
870      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
871      IF (ancien_ok) THEN      IF (ancien_ok) THEN
872         DO k = 1, llm         DO k = 1, llm
873            DO i = 1, klon            DO i = 1, klon
# Line 901  contains Line 900  contains
900      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
901      if (julien == 0) julien = 360      if (julien == 0) julien = 360
902    
903      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
904    
905      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
906    
# Line 912  contains Line 911  contains
911         wo = ozonecm(REAL(julien), paprs)         wo = ozonecm(REAL(julien), paprs)
912      ENDIF      ENDIF
913    
914      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
915        DO k = 1, llm
     DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse  
916         DO i = 1, klon         DO i = 1, klon
917            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
918            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
919            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  
920            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
921         ENDDO         ENDDO
922      ENDDO      ENDDO
923        ql_seri = 0.
924    
925      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
926         ztit='after reevap'         ztit = 'after reevap'
927         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, &
928              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, &
929              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 966  contains Line 960  contains
960      ENDIF      ENDIF
961    
962      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
963      albsol(:)=0.      albsol(:) = 0.
964      albsollw(:)=0.      albsollw(:) = 0.
965      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
966         DO i = 1, klon         DO i = 1, klon
967            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1003  contains Line 997  contains
997    
998      ! Incrémentation des flux      ! Incrémentation des flux
999    
1000      zxfluxt=0.      zxfluxt = 0.
1001      zxfluxq=0.      zxfluxq = 0.
1002      zxfluxu=0.      zxfluxu = 0.
1003      zxfluxv=0.      zxfluxv = 0.
1004      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1005         DO k = 1, llm         DO k = 1, llm
1006            DO i = 1, klon            DO i = 1, klon
# Line 1037  contains Line 1031  contains
1031      ENDDO      ENDDO
1032    
1033      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1034         ztit='after clmain'         ztit = 'after clmain'
1035         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, &
1036              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, &
1037              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1071  contains Line 1065  contains
1065         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1066    
1067         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1068              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1069              THEN              THEN
1070            WRITE(*, *) 'physiq : pb sous surface au point ', i, &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1071                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
# Line 1116  contains Line 1110  contains
1110            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1111            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
1112                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1113            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1114            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1115            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1116            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1117            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1118            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1119            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1120            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1121            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1122            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1123         ENDDO         ENDDO
1124      ENDDO      ENDDO
1125    
# Line 1147  contains Line 1141  contains
1141      ENDDO      ENDDO
1142      IF (check) THEN      IF (check) THEN
1143         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1144         print *, "avantcon=", za         print *, "avantcon = ", za
1145      ENDIF      ENDIF
1146      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1147      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1148      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1149         DO i = 1, klon         DO i = 1, klon
1150            z_avant(i) = 0.0            z_avant(i) = 0.0
1151         ENDDO         ENDDO
1152         DO k = 1, llm         DO k = 1, llm
1153            DO i = 1, klon            DO i = 1, klon
1154               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)) &
1155                    *zmasse(i, k)                    *zmasse(i, k)
1156            ENDDO            ENDDO
1157         ENDDO         ENDDO
1158      ENDIF      ENDIF
1159      IF (iflag_con == 1) THEN  
1160         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1161      ELSE IF (iflag_con == 2) THEN      case (1)
1162         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1163              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1164              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1165              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1166              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1167                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1168                pmflxs)
1169         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1170         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1171         DO i = 1, klon         DO i = 1, klon
1172            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1173            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1174         ENDDO         ENDDO
1175      ELSE IF (iflag_con >= 3) THEN      case (3:)
1176         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1177         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1178         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1179         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1180         ntra = 1         ntra = 1
1181         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1182         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1183    
1184         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1185              ! new driver for convectL
1186            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1187                 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, &
1188                 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, &
1189                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1190                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1191                 pmflxs, da, phi, mp)                 pmflxs, da, phi, mp)
1192              clwcon0 = qcondc
1193            clwcon0=qcondc            pmfu = upwd + dnwd
           pmfu=upwd+dnwd  
1194         ELSE         ELSE
1195            ! MAF conema3 ne contient pas les traceurs            ! conema3 ne contient pas les traceurs
1196            CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &            CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1197                 u_seri, v_seri, tr_seri, ntra, &                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1198                 ema_work1, ema_work2, &                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1199                 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, &
1200                 rain_con, snow_con, ibas_con, itop_con, &                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1201                 upwd, dnwd, dnwd0, bas, top, &         ENDIF
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
1202    
1203         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1204            do i = 1, klon            do i = 1, klon
1205               wd(i)=0.0               wd(i) = 0.0
1206            enddo            enddo
1207         ENDIF         ENDIF
1208    
1209         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1210    
1211         DO k = 1, llm         DO k = 1, llm
1212            DO i = 1, klon            DO i = 1, klon
# Line 1233  contains Line 1224  contains
1224                     zx_qs = qsatl(zx_t)/play(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1225                  ENDIF                  ENDIF
1226               ENDIF               ENDIF
1227               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1228            ENDDO            ENDDO
1229         ENDDO         ENDDO
1230    
1231         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1232         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1233         call clouds_gno &         call clouds_gno &
1234              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1235      ELSE      case default
1236         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1237         stop 1         stop 1
1238      ENDIF      END select
1239    
1240      DO k = 1, llm      DO k = 1, llm
1241         DO i = 1, klon         DO i = 1, klon
# Line 1256  contains Line 1247  contains
1247      ENDDO      ENDDO
1248    
1249      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1250         ztit='after convect'         ztit = 'after convect'
1251         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, &
1252              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, &
1253              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1267  contains Line 1258  contains
1258    
1259      IF (check) THEN      IF (check) THEN
1260         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1261         print *,"aprescon=", za         print *,"aprescon = ", za
1262         zx_t = 0.0         zx_t = 0.0
1263         za = 0.0         za = 0.0
1264         DO i = 1, klon         DO i = 1, klon
# Line 1276  contains Line 1267  contains
1267                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1268         ENDDO         ENDDO
1269         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1270         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1271      ENDIF      ENDIF
1272      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1273         DO i = 1, klon         DO i = 1, klon
# Line 1284  contains Line 1275  contains
1275         ENDDO         ENDDO
1276         DO k = 1, llm         DO k = 1, llm
1277            DO i = 1, klon            DO i = 1, klon
1278               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)) &
1279                    *zmasse(i, k)                    *zmasse(i, k)
1280            ENDDO            ENDDO
1281         ENDDO         ENDDO
1282         DO i = 1, klon         DO i = 1, klon
1283            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) &
1284                 /z_apres(i)                 /z_apres(i)
1285         ENDDO         ENDDO
1286         DO k = 1, llm         DO k = 1, llm
1287            DO i = 1, klon            DO i = 1, klon
1288               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  
1289                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1290               ENDIF               ENDIF
1291            ENDDO            ENDDO
1292         ENDDO         ENDDO
1293      ENDIF      ENDIF
1294      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1295    
1296      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1297    
1298      d_t_ajs=0.      d_t_ajs = 0.
1299      d_u_ajs=0.      d_u_ajs = 0.
1300      d_v_ajs=0.      d_v_ajs = 0.
1301      d_q_ajs=0.      d_q_ajs = 0.
1302      fm_therm=0.      fm_therm = 0.
1303      entr_therm=0.      entr_therm = 0.
1304    
1305      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1306         ! Ajustement sec         ! Ajustement sec
# Line 1324  contains Line 1314  contains
1314      endif      endif
1315    
1316      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1317         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1318         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, &
1319              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, &
1320              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1332  contains Line 1322  contains
1322    
1323      ! Caclul des ratqs      ! Caclul des ratqs
1324    
1325      ! 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
1326      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1327      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1328         do k=1, llm         do k = 1, llm
1329            do i=1, klon            do i = 1, klon
1330               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1331                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1332                       +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)
1333               else               else
1334                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1335               endif               endif
1336            enddo            enddo
1337         enddo         enddo
1338      endif      endif
1339    
1340      ! ratqs stables      ! ratqs stables
1341      do k=1, llm      do k = 1, llm
1342         do i=1, klon         do i = 1, klon
1343            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1344                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1345         enddo         enddo
1346      enddo      enddo
# Line 1361  contains Line 1351  contains
1351         ! ratqs final         ! ratqs final
1352         ! 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
1353         ! relaxation des ratqs         ! relaxation des ratqs
1354         facteur=exp(-dtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1355         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1356         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1357      else      else
1358         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1359         ratqs=ratqss         ratqs = ratqss
1360      endif      endif
1361    
1362      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1363      ! et le processus de precipitation      ! précipitation :
1364      CALL fisrtilp(dtphys, paprs, play, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1365           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1366           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1367           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1368    
1369      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1370      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1392  contains Line 1379  contains
1379      ENDDO      ENDDO
1380      IF (check) THEN      IF (check) THEN
1381         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1382         print *,"apresilp=", za         print *,"apresilp = ", za
1383         zx_t = 0.0         zx_t = 0.0
1384         za = 0.0         za = 0.0
1385         DO i = 1, klon         DO i = 1, klon
# Line 1401  contains Line 1388  contains
1388                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1389         ENDDO         ENDDO
1390         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1391         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1392      ENDIF      ENDIF
1393    
1394      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1395         ztit='after fisrt'         ztit = 'after fisrt'
1396         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, &
1397              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, &
1398              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1419  contains Line 1406  contains
1406      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1407    
1408      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1409         snow_tiedtke=0.         snow_tiedtke = 0.
1410         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1411            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1412         else         else
1413            rain_tiedtke=0.            rain_tiedtke = 0.
1414            do k=1, llm            do k = 1, llm
1415               do i=1, klon               do i = 1, klon
1416                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1417                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1418                          *zmasse(i, k)                          *zmasse(i, k)
1419                  endif                  endif
1420               enddo               enddo
# Line 1440  contains Line 1427  contains
1427              diafra, dialiq)              diafra, dialiq)
1428         DO k = 1, llm         DO k = 1, llm
1429            DO i = 1, klon            DO i = 1, klon
1430               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1431                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1432                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1433               ENDIF               ENDIF
# Line 1451  contains Line 1438  contains
1438         ! 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
1439         ! facttemps         ! facttemps
1440         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1441         do k=1, llm         do k = 1, llm
1442            do i=1, klon            do i = 1, klon
1443               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1444               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)) &
1445                    then                    then
1446                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1447                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1448               endif               endif
1449            enddo            enddo
1450         enddo         enddo
1451    
1452         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1453         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1454         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
1455      ENDIF      ENDIF
1456    
1457      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1458    
1459      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1460         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1461         DO k = 1, llm         DO k = 1, llm
1462            DO i = 1, klon            DO i = 1, klon
1463               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1464                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1465                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1466               ENDIF               ENDIF
# Line 1489  contains Line 1476  contains
1476      ENDDO      ENDDO
1477    
1478      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1479         ztit="after diagcld"         ztit = "after diagcld"
1480         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, &
1481              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, &
1482              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1483      END IF      END IF
1484    
1485      ! Calculer l'humidite relative pour diagnostique      ! Humidité relative pour diagnostic:
   
1486      DO k = 1, llm      DO k = 1, llm
1487         DO i = 1, klon         DO i = 1, klon
1488            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1514  contains Line 1500  contains
1500               ENDIF               ENDIF
1501            ENDIF            ENDIF
1502            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1503            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1504         ENDDO         ENDDO
1505      ENDDO      ENDDO
1506      !jq - introduce the aerosol direct and first indirect radiative forcings  
1507      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1508      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1509        IF (ok_ade .OR. ok_aie) THEN
1510         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1511         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1512         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1513    
1514         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1515         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1516              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1517      ELSE      ELSE
1518         tau_ae=0.0         tau_ae = 0.
1519         piz_ae=0.0         piz_ae = 0.
1520         cg_ae=0.0         cg_ae = 0.
1521      ENDIF      ENDIF
1522    
1523      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour
1524      ! parametres pour diagnostiques:      ! diagnostics :
   
1525      if (ok_newmicro) then      if (ok_newmicro) then
1526         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1527              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1528              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1529              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1530      else      else
1531         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1532              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1533              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1534      endif      endif
1535    
1536      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1537      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1538         DO i = 1, klon         DO i = 1, klon
1539            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1584  contains Line 1560  contains
1560    
1561      DO k = 1, llm      DO k = 1, llm
1562         DO i = 1, klon         DO i = 1, klon
1563            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.  
1564         ENDDO         ENDDO
1565      ENDDO      ENDDO
1566    
1567      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1568         ztit='after rad'         ztit = 'after rad'
1569         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, &
1570              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, &
1571              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1611  contains Line 1586  contains
1586         ENDDO         ENDDO
1587      ENDDO      ENDDO
1588    
1589      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1590    
1591      DO i = 1, klon      DO i = 1, klon
1592         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1593      ENDDO      ENDDO
1594    
1595      !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:  
1596    
1597      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1598         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1599         igwd=0         igwd = 0
1600         DO i=1, klon         DO i = 1, klon
1601            itest(i)=0            itest(i) = 0
1602            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
1603               itest(i)=1               itest(i) = 1
1604               igwd=igwd+1               igwd = igwd + 1
1605               idx(igwd)=i               idx(igwd) = i
1606            ENDIF            ENDIF
1607         ENDDO         ENDDO
1608    
1609         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1610              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1611              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)  
1612    
1613         ! ajout des tendances         ! ajout des tendances
1614         DO k = 1, llm         DO k = 1, llm
# Line 1651  contains Line 1621  contains
1621      ENDIF      ENDIF
1622    
1623      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1624         ! selection des points pour lesquels le shema est actif:         ! Sélection des points pour lesquels le schéma est actif :
1625         igwd=0         igwd = 0
1626         DO i=1, klon         DO i = 1, klon
1627            itest(i)=0            itest(i) = 0
1628            IF ((zpic(i)-zmea(i)).GT.100.) THEN            IF ((zpic(i) - zmea(i)) > 100.) THEN
1629               itest(i)=1               itest(i) = 1
1630               igwd=igwd+1               igwd = igwd + 1
1631               idx(igwd)=i               idx(igwd) = i
1632            ENDIF            ENDIF
1633         ENDDO         ENDDO
1634    
# Line 1666  contains Line 1636  contains
1636              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1637              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1638    
1639         ! ajout des tendances         ! Ajout des tendances :
1640         DO k = 1, llm         DO k = 1, llm
1641            DO i = 1, klon            DO i = 1, klon
1642               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 1679  contains Line 1649  contains
1649      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1650    
1651      DO i = 1, klon      DO i = 1, klon
1652         zustrph(i)=0.         zustrph(i) = 0.
1653         zvstrph(i)=0.         zvstrph(i) = 0.
1654      ENDDO      ENDDO
1655      DO k = 1, llm      DO k = 1, llm
1656         DO i = 1, klon         DO i = 1, klon
1657            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)
1658            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)
1659         ENDDO         ENDDO
1660      ENDDO      ENDDO
1661    
1662      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1663             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
     CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &  
          aam, torsfc)  
1664    
1665      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1666         ztit='after orography'         ztit = 'after orography'
1667         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, &
1668              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, &
1669              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1722  contains Line 1689  contains
1689    
1690      ! diag. bilKP      ! diag. bilKP
1691    
1692      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, &
1693           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1694    
1695      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1696    
1697      !+jld ec_conser      ! conversion Ec -> E thermique
1698      DO k = 1, llm      DO k = 1, llm
1699         DO i = 1, klon         DO i = 1, klon
1700            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1701            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1702                 *(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)
1703            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)
1704            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1705         END DO         END DO
1706      END DO      END DO
1707      !-jld ec_conser  
1708      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1709         ztit='after physic'         ztit = 'after physic'
1710         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, &
1711              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, &
1712              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
# Line 1751  contains Line 1718  contains
1718              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, &
1719              fs_bound, fq_bound)              fs_bound, fq_bound)
1720    
1721         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1722    
1723      END IF      END IF
1724    
# Line 1870  contains Line 1837  contains
1837           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1838    
1839           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1840           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)
1841           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1842    
1843           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1844           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)
1845           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1846    
1847           DO i = 1, klon           DO i = 1, klon
1848              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1849           ENDDO           ENDDO
1850           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)
1851           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1852    
1853           DO i = 1, klon           DO i = 1, klon
1854              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1855           ENDDO           ENDDO
1856           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)
1857           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1858    
1859           DO i = 1, klon           DO i = 1, klon
1860              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1861           ENDDO           ENDDO
1862           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)
1863           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1864    
1865           DO i = 1, klon           DO i = 1, klon
1866              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1867           ENDDO           ENDDO
1868           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)
1869           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1870    
1871           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)
1872           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1873           !ccIM           !ccIM
1874           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)
1875           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1876    
1877           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)
1878           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1879    
1880           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)
1881           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1882    
1883           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)
1884           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1885    
1886           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)
1887           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1888    
1889           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)
1890           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1891    
1892           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)
1893           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1894    
1895           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)
1896           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1897    
1898           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)
1899           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1900    
1901           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)
1902           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1903    
1904           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)
1905           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1906    
1907           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)
1908           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1909    
1910           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)
1911           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1912    
1913           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1914           ! 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)
1915           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)
1916           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1917    
1918           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)
1919           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1920    
1921           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)
1922           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1923    
1924           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)
1925           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1926    
1927           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)
1928           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1929    
1930           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)
1931           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1932    
1933           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1934              !XXX              !XXX
1935              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1936              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)
1937              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1938                   zx_tmp_2d)                   zx_tmp_2d)
1939    
1940              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1941              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)
1942              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1943                   zx_tmp_2d)                   zx_tmp_2d)
1944    
1945              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1946              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)
1947              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1948                   zx_tmp_2d)                   zx_tmp_2d)
1949    
1950              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1951              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)
1952              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1953                   zx_tmp_2d)                   zx_tmp_2d)
1954    
1955              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1956              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)
1957              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1958                   zx_tmp_2d)                   zx_tmp_2d)
1959    
1960              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1961              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)
1962              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1963                   zx_tmp_2d)                   zx_tmp_2d)
1964    
1965              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1966              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)
1967              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1968                   zx_tmp_2d)                   zx_tmp_2d)
1969    
1970              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1971              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)
1972              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1973                   zx_tmp_2d)                   zx_tmp_2d)
1974    
1975              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1976              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)
1977              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1978                   zx_tmp_2d)                   zx_tmp_2d)
1979    
1980           END DO           END DO
1981           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)
1982           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1983           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)
1984           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1985    
1986           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)
1987           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1988    
          !IM cf. AM 081204 BEG  
   
1989           !HBTM2           !HBTM2
1990    
1991           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)
1992           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1993    
1994           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)
1995           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1996    
1997           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)
1998           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1999    
2000           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)
2001           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
2002    
2003           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)
2004           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
2005    
2006           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)
2007           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
2008    
2009           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)
2010           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
2011    
2012           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)
2013           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
2014    
2015           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)
2016           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
2017    
2018           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)
2019           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2020    
          !IM cf. AM 081204 END  
   
2021           ! Champs 3D:           ! Champs 3D:
2022    
2023           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)
2024           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
2025    
2026           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)
2027           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
2028    
2029           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)
2030           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
2031    
2032           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)
2033           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2034    
2035           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)
2036           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2037    
2038           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)
2039           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2040    
2041           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)
2042           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2043    
2044           if (ok_sync) then           if (ok_sync) then
# Line 2099  contains Line 2062  contains
2062    
2063        ! Champs 3D:        ! Champs 3D:
2064    
2065        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)
2066        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2067    
2068        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)
2069        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2070    
2071        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)
2072        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2073    
2074        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)
2075        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2076    
2077        if (nbtr >= 3) then        if (nbtr >= 3) then
2078           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), &
2079                zx_tmp_3d)                zx_tmp_3d)
2080           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2081        end if        end if
Legend:
Removed from v.49  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.21