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

Diff of /trunk/phylmd/physiq.f

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

revision 49 by guez, Wed Aug 24 11:43:14 2011 UTC revision 68 by guez, Wed Nov 14 16:59:30 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 aeropt_m, only: aeropt
18           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      use ajsec_m, only: ajsec
19      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      USE calendar, ONLY: ymds2ju
20           cycle_diurne, new_oliq, soil_model      use calltherm_m, only: calltherm
21      use clmain_m, only: clmain      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
22      use comgeomphy           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
23      use concvl_m, only: concvl      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
24      use conf_gcm_m, only: raz_date, offline           ok_orodr, ok_orolf, soil_model
25      use conf_phys_m, only: conf_phys      USE clmain_m, ONLY: clmain
26      use ctherm      USE comgeomphy, ONLY: airephy, cuphy, cvphy
27      use dimens_m, only: jjm, iim, llm, nqmx      USE concvl_m, ONLY: concvl
28      use dimphy, only: klon, nbtr      USE conf_gcm_m, ONLY: offline, raz_date
29      use dimsoil, only: nsoilmx      USE conf_phys_m, ONLY: conf_phys
30      use fcttre, only: thermcep, foeew, qsats, qsatl      use conflx_m, only: conflx
31      use hgardfou_m, only: hgardfou      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
32      USE histcom, only: histsync      use diagcld2_m, only: diagcld2
33      USE histwrite_m, only: histwrite      use diagetpq_m, only: diagetpq
34      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, clnsurf, epsfra      use diagphy_m, only: diagphy
35      use ini_histhf_m, only: ini_histhf      USE dimens_m, ONLY: iim, jjm, llm, nqmx
36      use ini_histday_m, only: ini_histday      USE dimphy, ONLY: klon, nbtr
37      use ini_histins_m, only: ini_histins      USE dimsoil, ONLY: nsoilmx
38      use iniprint, only: prt_level      use drag_noro_m, only: drag_noro
39      use oasis_m      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
40      use orbite_m, only: orbite, zenang      use fisrtilp_m, only: fisrtilp
41      use ozonecm_m, only: ozonecm      USE hgardfou_m, ONLY: hgardfou
42      use phyetat0_m, only: phyetat0, rlat, rlon      USE histsync_m, ONLY: histsync
43      use phyredem_m, only: phyredem      USE histwrite_m, ONLY: histwrite
44      use phystokenc_m, only: phystokenc      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
45      use phytrac_m, only: phytrac           nbsrf
46      use qcheck_m, only: qcheck      USE ini_histhf_m, ONLY: ini_histhf
47      use radepsi      USE ini_histday_m, ONLY: ini_histday
48      use radopt      USE ini_histins_m, ONLY: ini_histins
49      use SUPHEC_M, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use newmicro_m, only: newmicro
50      use temps, only: itau_phy, day_ref, annee_ref      USE oasis_m, ONLY: ok_oasis
51      use yoethf_m      USE orbite_m, ONLY: orbite, zenang
52        USE ozonecm_m, ONLY: ozonecm
53        USE phyetat0_m, ONLY: phyetat0, rlat, rlon
54        USE phyredem_m, ONLY: phyredem
55        USE phystokenc_m, ONLY: phystokenc
56        USE phytrac_m, ONLY: phytrac
57        USE qcheck_m, ONLY: qcheck
58        use radlwsw_m, only: radlwsw
59        use sugwd_m, only: sugwd
60        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61        USE temps, ONLY: annee_ref, day_ref, itau_phy
62        use unit_nml_m, only: unit_nml
63        USE yoethf_m, ONLY: r2es, rvtmp2
64    
65      ! Variables argument:      ! Arguments:
66    
67      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
68      ! (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 71  contains
71      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
72      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
73    
74      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
75      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
76    
77      REAL, intent(in):: play(klon, llm)      REAL, intent(in):: play(klon, llm)
# Line 68  contains Line 80  contains
80      REAL, intent(in):: pphi(klon, llm)      REAL, intent(in):: pphi(klon, llm)
81      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
82    
83      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
84    
85      REAL, intent(in):: u(klon, llm)      REAL, intent(in):: u(klon, llm)
86      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m/s
87        
88      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
89      REAL t(klon, llm) ! input temperature (K)      REAL, intent(in):: t(klon, llm) ! input temperature (K)
90    
91      REAL, intent(in):: qx(klon, llm, nqmx)      REAL, intent(in):: qx(klon, llm, nqmx)
92      ! (humidité spécifique et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
# Line 89  contains Line 101  contains
101      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
105    
106      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
107      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
108    
     LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
109      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
110      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
111    
112      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
113      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
114    
115      LOGICAL, PARAMETER:: ok_stratus=.FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
116      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
117    
118      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
119      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
120      logical rnpb      logical rnpb
121      parameter(rnpb=.true.)      parameter(rnpb = .true.)
122    
123      character(len=6), save:: ocean      character(len = 6):: ocean = 'force '
124      ! (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")
125    
126      logical ok_ocean      logical ok_ocean
# Line 123  contains Line 133  contains
133      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
134    
135      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
136      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
137    
138      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
139      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
140        ! fichiers histday, histmth et histins
141    
142      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
143      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
144    
145      ! pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
146      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
147      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
148      real, save:: q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
149    
150      INTEGER ivap ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
151      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
152      INTEGER iliq ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
153      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
154    
155      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
156      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
# Line 154  contains Line 162  contains
162    
163      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
164    
165      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
166      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
167      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
168      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 162  contains Line 170  contains
170      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
171    
172      INTEGER klevp1      INTEGER klevp1
173      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
174    
175      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
176      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
# Line 176  contains Line 184  contains
184      ! variables a une pression donnee      ! variables a une pression donnee
185    
186      integer nlevSTD      integer nlevSTD
187      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
188      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
189      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
190           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
191           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
192      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
193      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
194           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
195           '70 ', '50 ', '30 ', '20 ', '10 '/           '70 ', '50 ', '30 ', '20 ', '10 '/
# Line 195  contains Line 203  contains
203      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
204    
205      INTEGER kmax, lmax      INTEGER kmax, lmax
206      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
207      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
208      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
209    
210      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
211      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 216  contains
216      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
217    
218      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
219      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
220    
221      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
222      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
223      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
224    
225      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
226      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', &
227           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
228           '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 342  contains Line 350  contains
350      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
351      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
352    
353      !AA      REAL, save:: rain_fall(klon) ! pluie
354      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
355      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
356      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
357    
358      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
# 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
     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 calculé tous les pas, il faut donc que
425        ! 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, save:: cool(klon, llm) ! refroidissement infrarouge
429      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
430      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)
431      real sollwdown(klon) ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
432      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
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 albpla, sollwdown
437      ! sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE topsw0, toplw0, solsw0, sollw0, heat0, cool0  
438    
439      INTEGER itaprad      INTEGER itaprad
440      SAVE itaprad      SAVE 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 478  contains Line 481  contains
481      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
482      REAL s_trmb3(klon)      REAL s_trmb3(klon)
483    
484      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
485    
486      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
487      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# 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)
   
     INTEGER ibas_con(klon), itop_con(klon)  
524    
525      SAVE ibas_con, itop_con      INTEGER, save:: ibas_con(klon), itop_con(klon)
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 535  contains Line 536  contains
536      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
537      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
538    
539      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
540      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
541      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
542    
543      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
544      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
545      real, save:: facttemps      real:: facttemps = 1.e-4
546      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
547      real facteur      real facteur
548    
549      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
550      logical ptconv(klon, llm)      logical ptconv(klon, llm)
551    
552      ! Variables locales pour effectuer les appels en série      ! Variables locales pour effectuer les appels en série :
553    
554      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
555      REAL ql_seri(klon, llm), qs_seri(klon, llm)      REAL ql_seri(klon, llm), qs_seri(klon, llm)
# Line 567  contains Line 565  contains
565      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
566      REAL aam, torsfc      REAL aam, torsfc
567    
568      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim + 1, jjm + 1, llm)
569    
570      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
571      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 579  contains
579    
580      REAL zsto      REAL zsto
581    
582      character(len=20) modname      character(len = 20) modname
583      character(len=80) abort_message      character(len = 80) abort_message
584      logical ok_sync      logical ok_sync
585      real date0      real date0
586    
587      ! Variables liees au bilan d'energie et d'enthalpi      ! Variables liées au bilan d'énergie et d'enthalpie :
588      REAL ztsol(klon)      REAL ztsol(klon)
589      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
590      REAL d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
591      REAL fs_bound, fq_bound      REAL fs_bound, fq_bound
     SAVE d_h_vcol_phy  
592      REAL zero_v(klon)      REAL zero_v(klon)
593      CHARACTER(LEN=15) ztit      CHARACTER(LEN = 15) tit
594      INTEGER ip_ebil ! PRINT level for energy conserv. diag.      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
595      SAVE ip_ebil      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
596      DATA ip_ebil/0/  
597      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
     !+jld ec_conser  
     REAL d_t_ec(klon, llm) ! tendance du a la conersion Ec -> E thermique  
598      REAL ZRCPD      REAL ZRCPD
599      !-jld ec_conser  
     !IM: t2m, q2m, u10m, v10m  
600      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
601      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m
602      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 620  contains Line 614  contains
614      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
615    
616      ! Aerosol optical properties      ! Aerosol optical properties
617      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
618      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
619    
620      REAL topswad(klon), solswad(klon) ! Aerosol direct effect.      REAL topswad(klon), solswad(klon) ! aerosol direct effect
621      ! ok_ade=True -ADE=topswad-topsw      ! ok_ade --> ADE = topswad - topsw
622    
623      REAL topswai(klon), solswai(klon) ! Aerosol indirect effect.      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
624      ! ok_aie=True ->      ! ok_aie .and. ok_ade --> AIE = topswai - topswad
625      ! ok_ade=True -AIE=topswai-topswad      ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw
     ! ok_ade=F -AIE=topswai-topsw  
626    
627      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
628    
629      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
630      LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
631      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)  
632        REAL:: bl95_b0 = 2., bl95_b1 = 0.2
633        ! Parameters in the formula to link CDNC to aerosol mass conc
634        ! (Boucher and Lohmann, 1995), used in nuage.F
635    
     SAVE ok_ade, ok_aie, bl95_b0, bl95_b1  
636      SAVE u10m      SAVE u10m
637      SAVE v10m      SAVE v10m
638      SAVE t2m      SAVE t2m
639      SAVE q2m      SAVE q2m
640      SAVE ffonte      SAVE ffonte
641      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
642      SAVE rain_con      SAVE rain_con
643      SAVE snow_con      SAVE snow_con
644      SAVE topswai      SAVE topswai
# Line 663  contains Line 655  contains
655    
656      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
657    
658        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
659             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
660             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
661             nsplit_thermals
662    
663      !----------------------------------------------------------------      !----------------------------------------------------------------
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         iflag_thermals = 0
718           nsplit_thermals = 1
719           print *, "Enter namelist 'physiq_nml'."
720           read(unit=*, nml=physiq_nml)
721           write(unit_nml, nml=physiq_nml)
722    
723         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         ! Appel à la lecture du run.def physique
724              ok_instan, fact_cldcon, facttemps, ok_newmicro, &         call conf_phys
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie, &  
             bl95_b0, bl95_b1, &  
             iflag_thermals, nsplit_thermals)  
725    
726         ! Initialiser les compteurs:         ! Initialiser les compteurs:
727    
# 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
        print *,"Clef pour le driver de la convection, ok_cvl=", &  
             ok_cvl  
761    
762         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
763         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
764              print *, "Convection de Kerry Emanuel 4.3"
765    
           print *,"*** Convection de Kerry Emanuel 4.3 "  
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
766            DO i = 1, klon            DO i = 1, klon
767               ibas_con(i) = 1               ibas_con(i) = 1
768               itop_con(i) = 1               itop_con(i) = 1
769            ENDDO            ENDDO
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
770         ENDIF         ENDIF
771    
772         IF (ok_orodr) THEN         IF (ok_orodr) THEN
773            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
774            CALL SUGWD(klon, llm, paprs, play)            CALL SUGWD(paprs, play)
775         else         else
776            rugoro = 0.            rugoro = 0.
777         ENDIF         ENDIF
# Line 799  contains Line 790  contains
790         npas = 0         npas = 0
791         nexca = 0         nexca = 0
792    
        print *,'AVANT HIST IFLAG_CON=', iflag_con  
   
793         ! Initialisation des sorties         ! Initialisation des sorties
794    
795         call ini_histhf(dtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
# Line 808  contains Line 797  contains
797         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
798         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
799         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
800         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
801      ENDIF test_firstcal      ENDIF test_firstcal
802    
803      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 823  contains Line 812  contains
812            ENDDO            ENDDO
813         ENDDO         ENDDO
814      ENDDO      ENDDO
815      da=0.      da = 0.
816      mp=0.      mp = 0.
817      phi=0.      phi = 0.
818    
819      ! 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 :
820    
821      DO k = 1, llm      DO k = 1, llm
822         DO i = 1, klon         DO i = 1, klon
# Line 855  contains Line 844  contains
844      ENDDO      ENDDO
845    
846      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
847         ztit='after dynamic'         tit = 'after dynamics'
848         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
849              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, &
850              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
851         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
852         ! on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
853         ! est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
854         ! Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
855         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         !  nulle.
856              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol+d_h_vcol_phy, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
857                zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
858              d_qt, 0., fs_bound, fq_bound)              d_qt, 0., fs_bound, fq_bound)
859      END IF      END IF
860    
861      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
862      IF (ancien_ok) THEN      IF (ancien_ok) THEN
863         DO k = 1, llm         DO k = 1, llm
864            DO i = 1, klon            DO i = 1, klon
# Line 901  contains Line 891  contains
891      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
892      if (julien == 0) julien = 360      if (julien == 0) julien = 360
893    
894      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
895    
896      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
897    
898      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
899      if (nqmx >= 5) then      wo = ozonecm(REAL(julien), paprs)
        wo = qx(:, :, 5) * zmasse / dobson_u / 1e3  
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Re-evaporer l'eau liquide nuageuse  
900    
901      DO k = 1, llm ! re-evaporation de l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
902        DO k = 1, llm
903         DO i = 1, klon         DO i = 1, klon
904            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
905            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
906            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  
907            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
908         ENDDO         ENDDO
909      ENDDO      ENDDO
910        ql_seri = 0.
911    
912      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
913         ztit='after reevap'         tit = 'after reevap'
914         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
915              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, &
916              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
917         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
918              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
919              fs_bound, fq_bound)              fs_bound, fq_bound)
920    
# Line 966  contains Line 947  contains
947      ENDIF      ENDIF
948    
949      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
950      albsol(:)=0.      albsol(:) = 0.
951      albsollw(:)=0.      albsollw(:) = 0.
952      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
953         DO i = 1, klon         DO i = 1, klon
954            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1003  contains Line 984  contains
984    
985      ! Incrémentation des flux      ! Incrémentation des flux
986    
987      zxfluxt=0.      zxfluxt = 0.
988      zxfluxq=0.      zxfluxq = 0.
989      zxfluxu=0.      zxfluxu = 0.
990      zxfluxv=0.      zxfluxv = 0.
991      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
992         DO k = 1, llm         DO k = 1, llm
993            DO i = 1, klon            DO i = 1, klon
# Line 1037  contains Line 1018  contains
1018      ENDDO      ENDDO
1019    
1020      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1021         ztit='after clmain'         tit = 'after clmain'
1022         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1023              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, &
1024              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1025         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1026              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1027              fs_bound, fq_bound)              fs_bound, fq_bound)
1028      END IF      END IF
# Line 1071  contains Line 1052  contains
1052         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1053    
1054         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1055              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1056              THEN              THEN
1057            WRITE(*, *) 'physiq : pb sous surface au point ', i, &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1058                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
# Line 1116  contains Line 1097  contains
1097            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1098            IF (pctsrf(i, nsrf) < epsfra) &            IF (pctsrf(i, nsrf) < epsfra) &
1099                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1100            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1101            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1102            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1103            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1104            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1105            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1106            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1107            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1108            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1109            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1110         ENDDO         ENDDO
1111      ENDDO      ENDDO
1112    
# Line 1147  contains Line 1128  contains
1128      ENDDO      ENDDO
1129      IF (check) THEN      IF (check) THEN
1130         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1131         print *, "avantcon=", za         print *, "avantcon = ", za
1132      ENDIF      ENDIF
1133      zx_ajustq = .FALSE.      zx_ajustq = iflag_con == 2
     IF (iflag_con == 2) zx_ajustq=.TRUE.  
1134      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1135         DO i = 1, klon         DO i = 1, klon
1136            z_avant(i) = 0.0            z_avant(i) = 0.0
1137         ENDDO         ENDDO
1138         DO k = 1, llm         DO k = 1, llm
1139            DO i = 1, klon            DO i = 1, klon
1140               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)) &
1141                    *zmasse(i, k)                    *zmasse(i, k)
1142            ENDDO            ENDDO
1143         ENDDO         ENDDO
1144      ENDIF      ENDIF
1145      IF (iflag_con == 1) THEN  
1146         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1147      ELSE IF (iflag_con == 2) THEN      case (2)
1148         CALL conflx(dtphys, paprs, play, t_seri, q_seri, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1149              conv_t, conv_q, zxfluxq(1, 1), omega, &              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1150              d_t_con, d_q_con, rain_con, snow_con, &              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1151              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmflxs)
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
1152         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1153         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1154         DO i = 1, klon         DO i = 1, klon
1155            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1156            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1157         ENDDO         ENDDO
1158      ELSE IF (iflag_con >= 3) THEN      case (3:)
1159         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1160         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1161         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1162         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1163         ntra = 1         ntra = 1
1164         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1165         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1166    
1167         IF (ok_cvl) THEN ! new driver for convectL         CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &
1168            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &              v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1169                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &
1170                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &              upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &
1171                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &              dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
1172                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &              da, phi, mp)
1173                 pmflxs, da, phi, mp)         clwcon0 = qcondc
1174           pmfu = upwd + dnwd
           clwcon0=qcondc  
           pmfu=upwd+dnwd  
        ELSE  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (dtphys, paprs, play, t_seri, q_seri, &  
                u_seri, v_seri, tr_seri, ntra, &  
                ema_work1, ema_work2, &  
                d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &  
                rain_con, snow_con, ibas_con, itop_con, &  
                upwd, dnwd, dnwd0, bas, top, &  
                Ma, cape, tvp, rflag, &  
                pbase &  
                , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &  
                , clwcon0)  
        ENDIF ! ok_cvl  
1175    
1176         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1177            do i = 1, klon            do i = 1, klon
1178               wd(i)=0.0               wd(i) = 0.0
1179            enddo            enddo
1180         ENDIF         ENDIF
1181    
1182         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1183    
1184         DO k = 1, llm         DO k = 1, llm
1185            DO i = 1, klon            DO i = 1, klon
# Line 1233  contains Line 1197  contains
1197                     zx_qs = qsatl(zx_t)/play(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1198                  ENDIF                  ENDIF
1199               ENDIF               ENDIF
1200               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1201            ENDDO            ENDDO
1202         ENDDO         ENDDO
1203    
1204         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1205         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1206         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1207              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1208      ELSE      case default
1209         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1210         stop 1         stop 1
1211      ENDIF      END select
1212    
1213      DO k = 1, llm      DO k = 1, llm
1214         DO i = 1, klon         DO i = 1, klon
# Line 1256  contains Line 1220  contains
1220      ENDDO      ENDDO
1221    
1222      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1223         ztit='after convect'         tit = 'after convect'
1224         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1225              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, &
1226              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1227         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1228              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1229              fs_bound, fq_bound)              fs_bound, fq_bound)
1230      END IF      END IF
1231    
1232      IF (check) THEN      IF (check) THEN
1233         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1234         print *,"aprescon=", za         print *, "aprescon = ", za
1235         zx_t = 0.0         zx_t = 0.0
1236         za = 0.0         za = 0.0
1237         DO i = 1, klon         DO i = 1, klon
# Line 1276  contains Line 1240  contains
1240                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1241         ENDDO         ENDDO
1242         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1243         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1244      ENDIF      ENDIF
1245      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1246         DO i = 1, klon         DO i = 1, klon
# Line 1284  contains Line 1248  contains
1248         ENDDO         ENDDO
1249         DO k = 1, llm         DO k = 1, llm
1250            DO i = 1, klon            DO i = 1, klon
1251               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)) &
1252                    *zmasse(i, k)                    *zmasse(i, k)
1253            ENDDO            ENDDO
1254         ENDDO         ENDDO
1255         DO i = 1, klon         DO i = 1, klon
1256            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) &
1257                 /z_apres(i)                 /z_apres(i)
1258         ENDDO         ENDDO
1259         DO k = 1, llm         DO k = 1, llm
1260            DO i = 1, klon            DO i = 1, klon
1261               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  
1262                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1263               ENDIF               ENDIF
1264            ENDDO            ENDDO
1265         ENDDO         ENDDO
1266      ENDIF      ENDIF
1267      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1268    
1269      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1270    
1271      d_t_ajs=0.      d_t_ajs = 0.
1272      d_u_ajs=0.      d_u_ajs = 0.
1273      d_v_ajs=0.      d_v_ajs = 0.
1274      d_q_ajs=0.      d_q_ajs = 0.
1275      fm_therm=0.      fm_therm = 0.
1276      entr_therm=0.      entr_therm = 0.
1277    
1278      if (iflag_thermals == 0) then      if (iflag_thermals == 0) then
1279         ! Ajustement sec         ! Ajustement sec
# Line 1324  contains Line 1287  contains
1287      endif      endif
1288    
1289      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1290         ztit='after dry_adjust'         tit = 'after dry_adjust'
1291         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1292              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, &
1293              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1294      END IF      END IF
1295    
1296      ! Caclul des ratqs      ! Caclul des ratqs
1297    
1298      ! 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
1299      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1300      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1301         do k=1, llm         do k = 1, llm
1302            do i=1, klon            do i = 1, klon
1303               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1304                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1305                       +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)
1306               else               else
1307                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1308               endif               endif
1309            enddo            enddo
1310         enddo         enddo
1311      endif      endif
1312    
1313      ! ratqs stables      ! ratqs stables
1314      do k=1, llm      do k = 1, llm
1315         do i=1, klon         do i = 1, klon
1316            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1317                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1318         enddo         enddo
1319      enddo      enddo
# Line 1361  contains Line 1324  contains
1324         ! ratqs final         ! ratqs final
1325         ! 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
1326         ! relaxation des ratqs         ! relaxation des ratqs
1327         facteur=exp(-dtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1328         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1329         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1330      else      else
1331         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1332         ratqs=ratqss         ratqs = ratqss
1333      endif      endif
1334    
1335      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1336      ! et le processus de precipitation      ! précipitation :
1337      CALL fisrtilp(dtphys, paprs, play, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1338           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1339           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1340           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1341    
1342      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1343      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1392  contains Line 1352  contains
1352      ENDDO      ENDDO
1353      IF (check) THEN      IF (check) THEN
1354         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1355         print *,"apresilp=", za         print *, "apresilp = ", za
1356         zx_t = 0.0         zx_t = 0.0
1357         za = 0.0         za = 0.0
1358         DO i = 1, klon         DO i = 1, klon
# Line 1401  contains Line 1361  contains
1361                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1362         ENDDO         ENDDO
1363         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1364         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1365      ENDIF      ENDIF
1366    
1367      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1368         ztit='after fisrt'         tit = 'after fisrt'
1369         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1370              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, &
1371              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1372         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1373              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1374              fs_bound, fq_bound)              fs_bound, fq_bound)
1375      END IF      END IF
# Line 1418  contains Line 1378  contains
1378    
1379      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1380    
1381      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1382         snow_tiedtke=0.         ! seulement pour Tiedtke
1383           snow_tiedtke = 0.
1384         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1385            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1386         else         else
1387            rain_tiedtke=0.            rain_tiedtke = 0.
1388            do k=1, llm            do k = 1, llm
1389               do i=1, klon               do i = 1, klon
1390                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1391                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1392                          *zmasse(i, k)                          *zmasse(i, k)
1393                  endif                  endif
1394               enddo               enddo
# Line 1440  contains Line 1401  contains
1401              diafra, dialiq)              diafra, dialiq)
1402         DO k = 1, llm         DO k = 1, llm
1403            DO i = 1, klon            DO i = 1, klon
1404               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1405                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1406                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1407               ENDIF               ENDIF
# Line 1451  contains Line 1412  contains
1412         ! 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
1413         ! facttemps         ! facttemps
1414         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1415         do k=1, llm         do k = 1, llm
1416            do i=1, klon            do i = 1, klon
1417               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1418               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)) &
1419                    then                    then
1420                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1421                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1422               endif               endif
1423            enddo            enddo
1424         enddo         enddo
1425    
1426         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1427         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1428         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
1429      ENDIF      ENDIF
1430    
1431      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1432    
1433      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1434         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1435         DO k = 1, llm         DO k = 1, llm
1436            DO i = 1, klon            DO i = 1, klon
1437               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1438                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1439                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1440               ENDIF               ENDIF
# Line 1482  contains Line 1443  contains
1443      ENDIF      ENDIF
1444    
1445      ! Precipitation totale      ! Precipitation totale
   
1446      DO i = 1, klon      DO i = 1, klon
1447         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1448         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1449      ENDDO      ENDDO
1450    
1451      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1452         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1453         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
   
     ! Calculer l'humidite relative pour diagnostique  
1454    
1455        ! Humidité relative pour diagnostic :
1456      DO k = 1, llm      DO k = 1, llm
1457         DO i = 1, klon         DO i = 1, klon
1458            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
# Line 1514  contains Line 1470  contains
1470               ENDIF               ENDIF
1471            ENDIF            ENDIF
1472            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1473            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1474         ENDDO         ENDDO
1475      ENDDO      ENDDO
1476      !jq - introduce the aerosol direct and first indirect radiative forcings  
1477      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1478      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1479         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1480         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1481         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1482    
1483         ! Calculate aerosol optical properties (Olivier Boucher)         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1484         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, &              aerindex)
             tau_ae, piz_ae, cg_ae, aerindex)  
1485      ELSE      ELSE
1486         tau_ae=0.0         tau_ae = 0.
1487         piz_ae=0.0         piz_ae = 0.
1488         cg_ae=0.0         cg_ae = 0.
1489      ENDIF      ENDIF
1490    
1491      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! parametres pour diagnostiques:  
   
1492      if (ok_newmicro) then      if (ok_newmicro) then
1493         CALL newmicro (paprs, play, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1494              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1495              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1496              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1497      else      else
1498         CALL nuage (paprs, play, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1499              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1500              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1501      endif      endif
1502    
1503      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1504      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1505         DO i = 1, klon         DO i = 1, klon
1506            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1569  contains Line 1512  contains
1512                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1513                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1514         ENDDO         ENDDO
1515         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1516         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1517              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1518              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
# Line 1584  contains Line 1527  contains
1527    
1528      DO k = 1, llm      DO k = 1, llm
1529         DO i = 1, klon         DO i = 1, klon
1530            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.  
1531         ENDDO         ENDDO
1532      ENDDO      ENDDO
1533    
1534      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1535         ztit='after rad'         tit = 'after rad'
1536         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1537              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, &
1538              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1539         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1540              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1541              fs_bound, fq_bound)              fs_bound, fq_bound)
1542      END IF      END IF
# Line 1611  contains Line 1553  contains
1553         ENDDO         ENDDO
1554      ENDDO      ENDDO
1555    
1556      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1557    
1558      DO i = 1, klon      DO i = 1, klon
1559         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1560      ENDDO      ENDDO
1561    
1562      !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:  
1563    
1564      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1565         ! selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1566         igwd=0         igwd = 0
1567         DO i=1, klon         DO i = 1, klon
1568            itest(i)=0            itest(i) = 0
1569            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
1570               itest(i)=1               itest(i) = 1
1571               igwd=igwd+1               igwd = igwd + 1
1572               idx(igwd)=i               idx(igwd) = i
1573            ENDIF            ENDIF
1574         ENDDO         ENDDO
1575    
1576         CALL drag_noro(klon, llm, dtphys, paprs, play, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1577              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1578              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)  
1579    
1580         ! ajout des tendances         ! ajout des tendances
1581         DO k = 1, llm         DO k = 1, llm
# Line 1651  contains Line 1588  contains
1588      ENDIF      ENDIF
1589    
1590      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1591         ! selection des points pour lesquels le shema est actif:         ! Sélection des points pour lesquels le schéma est actif :
1592         igwd=0         igwd = 0
1593         DO i=1, klon         DO i = 1, klon
1594            itest(i)=0            itest(i) = 0
1595            IF ((zpic(i)-zmea(i)).GT.100.) THEN            IF ((zpic(i) - zmea(i)) > 100.) THEN
1596               itest(i)=1               itest(i) = 1
1597               igwd=igwd+1               igwd = igwd + 1
1598               idx(igwd)=i               idx(igwd) = i
1599            ENDIF            ENDIF
1600         ENDDO         ENDDO
1601    
# Line 1666  contains Line 1603  contains
1603              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
1604              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1605    
1606         ! ajout des tendances         ! Ajout des tendances :
1607         DO k = 1, llm         DO k = 1, llm
1608            DO i = 1, klon            DO i = 1, klon
1609               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 1676  contains Line 1613  contains
1613         ENDDO         ENDDO
1614      ENDIF      ENDIF
1615    
1616      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! Stress nécessaires : toute la physique
1617    
1618      DO i = 1, klon      DO i = 1, klon
1619         zustrph(i)=0.         zustrph(i) = 0.
1620         zvstrph(i)=0.         zvstrph(i) = 0.
1621      ENDDO      ENDDO
1622      DO k = 1, llm      DO k = 1, llm
1623         DO i = 1, klon         DO i = 1, klon
1624            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 &
1625            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)                 * zmasse(i, k)
1626              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1627                   * zmasse(i, k)
1628         ENDDO         ENDDO
1629      ENDDO      ENDDO
1630    
1631      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1632             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)  
1633    
1634      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1635         ztit='after orography'           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1636         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &  
             d_ql, d_qs, d_ec)  
     END IF  
1637    
1638      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1639      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1640           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
1641           pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1642           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1643           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
          tr_seri, zmasse)  
1644    
1645      IF (offline) THEN      IF (offline) THEN
1646         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
# Line 1722  contains Line 1654  contains
1654    
1655      ! diag. bilKP      ! diag. bilKP
1656    
1657      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, &
1658           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1659    
1660      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1661    
1662      !+jld ec_conser      ! conversion Ec -> E thermique
1663      DO k = 1, llm      DO k = 1, llm
1664         DO i = 1, klon         DO i = 1, klon
1665            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1666            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1667                 *(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)
1668            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)
1669            d_t_ec(i, k) = d_t_ec(i, k)/dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1670         END DO         END DO
1671      END DO      END DO
1672      !-jld ec_conser  
1673      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1674         ztit='after physic'         tit = 'after physic'
1675         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1676              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, &
1677              d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1678         ! Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1679         ! on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1680         ! est egale a la variation de la physique au pas de temps precedent.         ! est egale a la variation de la physique au pas de temps precedent.
1681         ! Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1682         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1683              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, &
1684              fs_bound, fq_bound)              fs_bound, fq_bound)
1685    
1686         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1687    
1688      END IF      END IF
1689    
# Line 1870  contains Line 1802  contains
1802           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1803    
1804           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1805           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)
1806           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1807    
1808           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1809           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)
1810           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1811    
1812           DO i = 1, klon           DO i = 1, klon
1813              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1814           ENDDO           ENDDO
1815           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)
1816           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1817    
1818           DO i = 1, klon           DO i = 1, klon
1819              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1820           ENDDO           ENDDO
1821           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)
1822           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1823    
1824           DO i = 1, klon           DO i = 1, klon
1825              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1826           ENDDO           ENDDO
1827           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)
1828           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1829    
1830           DO i = 1, klon           DO i = 1, klon
1831              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1832           ENDDO           ENDDO
1833           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)
1834           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1835    
1836           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)
1837           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1838           !ccIM           !ccIM
1839           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)
1840           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1841    
1842           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)
1843           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1844    
1845           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)
1846           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1847    
1848           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)
1849           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1850    
1851           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)
1852           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1853    
1854           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)
1855           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1856    
1857           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)
1858           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1859    
1860           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)
1861           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1862    
1863           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)
1864           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1865    
1866           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)
1867           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1868    
1869           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)
1870           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1871    
1872           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)
1873           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1874    
1875           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)
1876           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1877    
1878           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1879           ! 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)
1880           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)
1881           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1882    
1883           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)
1884           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1885    
1886           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)
1887           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1888    
1889           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)
1890           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1891    
1892           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)
1893           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1894    
1895           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)
1896           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1897    
1898           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1899              !XXX              !XXX
1900              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1901              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)
1902              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1903                   zx_tmp_2d)                   zx_tmp_2d)
1904    
1905              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1906              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)
1907              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1908                   zx_tmp_2d)                   zx_tmp_2d)
1909    
1910              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1911              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)
1912              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1913                   zx_tmp_2d)                   zx_tmp_2d)
1914    
1915              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1916              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1917              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1918                   zx_tmp_2d)                   zx_tmp_2d)
1919    
1920              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1921              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)
1922              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1923                   zx_tmp_2d)                   zx_tmp_2d)
1924    
1925              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1926              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1927              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1928                   zx_tmp_2d)                   zx_tmp_2d)
1929    
1930              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1931              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)
1932              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1933                   zx_tmp_2d)                   zx_tmp_2d)
1934    
1935              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
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, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1938                   zx_tmp_2d)                   zx_tmp_2d)
1939    
1940              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(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, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1943                   zx_tmp_2d)                   zx_tmp_2d)
1944    
1945           END DO           END DO
1946           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)
1947           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1948           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)
1949           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1950    
1951           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)
1952           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1953    
          !IM cf. AM 081204 BEG  
   
1954           !HBTM2           !HBTM2
1955    
1956           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)
1957           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1958    
1959           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)
1960           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1961    
1962           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)
1963           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1964    
1965           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)
1966           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1967    
1968           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)
1969           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1970    
1971           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)
1972           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1973    
1974           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)
1975           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1976    
1977           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)
1978           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1979    
1980           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)
1981           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1982    
1983           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)
1984           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1985    
          !IM cf. AM 081204 END  
   
1986           ! Champs 3D:           ! Champs 3D:
1987    
1988           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)
1989           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1990    
1991           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)
1992           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1993    
1994           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)
1995           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1996    
1997           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)
1998           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1999    
2000           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)
2001           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2002    
2003           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)
2004           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2005    
2006           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)
2007           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2008    
2009           if (ok_sync) then           if (ok_sync) then
# Line 2099  contains Line 2027  contains
2027    
2028        ! Champs 3D:        ! Champs 3D:
2029    
2030        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)
2031        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2032    
2033        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)
2034        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2035    
2036        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)
2037        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2038    
2039        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)
2040        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2041    
2042        if (nbtr >= 3) then        if (nbtr >= 3) then
2043           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), &
2044                zx_tmp_3d)                zx_tmp_3d)
2045           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2046        end if        end if
Legend:
Removed from v.49  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.21