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