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

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

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

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