/[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 22 by guez, Fri Jul 31 15:18:47 2009 UTC revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 1  Line 1 
1  module physiq_m  module physiq_m
2    
   ! This module is clean: no C preprocessor directive, no include line.  
   
3    IMPLICIT none    IMPLICIT none
4    
   private  
   public physiq  
   
5  contains  contains
6    
7    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)
9         d_t, d_qx, d_ps, dudyn, PVteta)  
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)
11      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! Author: Z.X. Li (LMD/CNRS) 1993
   
     ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18  
   
     ! Objet: Moniteur general de la physique du modele  
     !AA      Modifications quant aux traceurs :  
     !AA                  -  uniformisation des parametrisations ds phytrac  
     !AA                  -  stockage des moyennes des champs necessaires  
     !AA                     en mode traceur off-line  
   
     USE ioipsl, only: ymds2ju, histwrite, histsync  
     use dimens_m, only: jjm, iim, llm  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline, iphysiq  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref, itaufin  
     use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &  
          cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &  
          ok_kzmin  
     use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &  
          cycle_diurne, new_oliq, soil_model  
     use iniprint, only: prt_level  
     use abort_gcm_m, only: abort_gcm  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
     use comgeomphy  
     use ctherm  
     use phytrac_m, only: phytrac  
     use oasis_m  
     use radepsi  
     use radopt  
     use yoethf  
     use ini_hist, only: ini_histhf, ini_histday, ini_histins  
     use orbite_m, only: orbite, zenang  
     use phyetat0_m, only: phyetat0, rlat, rlon  
     use hgardfou_m, only: hgardfou  
     use conf_phys_m, only: conf_phys  
     use phyredem_m, only: phyredem  
     use qcheck_m, only: qcheck  
     use ozonecm_m, only: ozonecm  
12    
13      ! Declaration des constantes et des fonctions thermodynamiques :      ! This is the main procedure for the "physics" part of the program.
     use fcttre, only: thermcep, foeew, qsats, qsatl  
14    
15      ! Variables argument:      use aaam_bud_m, only: aaam_bud
16        USE abort_gcm_m, ONLY: abort_gcm
17        use ajsec_m, only: ajsec
18        USE calendar, ONLY: ymds2ju
19        use calltherm_m, only: calltherm
20        USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
21             ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
22        USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
23             ok_orodr, ok_orolf, soil_model
24        USE clmain_m, ONLY: clmain
25        USE comgeomphy, ONLY: airephy, cuphy, cvphy
26        USE concvl_m, ONLY: concvl
27        USE conf_gcm_m, ONLY: offline, raz_date
28        USE conf_phys_m, ONLY: conf_phys
29        use conflx_m, only: conflx
30        USE ctherm, ONLY: iflag_thermals, nsplit_thermals
31        use diagcld2_m, only: diagcld2
32        use diagetpq_m, only: diagetpq
33        use diagphy_m, only: diagphy
34        USE dimens_m, ONLY: iim, jjm, llm, nqmx
35        USE dimphy, ONLY: klon, nbtr
36        USE dimsoil, ONLY: nsoilmx
37        use drag_noro_m, only: drag_noro
38        USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
39        USE hgardfou_m, ONLY: hgardfou
40        USE histsync_m, ONLY: histsync
41        USE histwrite_m, ONLY: histwrite
42        USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
43             nbsrf
44        USE ini_histhf_m, ONLY: ini_histhf
45        USE ini_histday_m, ONLY: ini_histday
46        USE ini_histins_m, ONLY: ini_histins
47        USE oasis_m, ONLY: ok_oasis
48        USE orbite_m, ONLY: orbite, zenang
49        USE ozonecm_m, ONLY: ozonecm
50        USE phyetat0_m, ONLY: phyetat0, rlat, rlon
51        USE phyredem_m, ONLY: phyredem
52        USE phystokenc_m, ONLY: phystokenc
53        USE phytrac_m, ONLY: phytrac
54        USE qcheck_m, ONLY: qcheck
55        use radlwsw_m, only: radlwsw
56        use sugwd_m, only: sugwd
57        USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
58        USE temps, ONLY: annee_ref, day_ref, itau_phy
59        USE yoethf_m, ONLY: r2es, rvtmp2
60    
61      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)      ! Arguments:
62    
63      REAL, intent(in):: rdayvrai      REAL, intent(in):: rdayvrai
64      ! (elapsed time since January 1st 0h of the starting year, in days)      ! (elapsed time since January 1st 0h of the starting year, in days)
65    
66      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: time ! heure de la journée en fraction de jour
67      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
68      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
69    
70      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
71      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
72    
73      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
74      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
75    
76      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
77      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
78    
79      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
80    
81        REAL, intent(in):: u(klon, llm)
82        ! vitesse dans la direction X (de O a E) en m/s
83    
84        REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
85        REAL, intent(in):: t(klon, llm) ! input temperature (K)
86    
87      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: qx(klon, llm, nqmx)
88      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      ! (humidité spécifique et fractions massiques des autres traceurs)
89      REAL t(klon, llm)  ! input temperature (K)  
90        REAL omega(klon, llm) ! input vitesse verticale en Pa/s
91      REAL, intent(in):: qx(klon, llm, nq)      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
92      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
93        REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
94      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
95      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_ps(klon) ! output tendance physique de la pression au sol
96      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)  
97      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      LOGICAL:: firstcal = .true.
     REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)  
     REAL d_ps(klon)  ! output tendance physique de la pression au sol  
98    
99      INTEGER nbteta      INTEGER nbteta
100      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
101    
102      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
103      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
104    
     LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE  
     PARAMETER (ok_cvl=.TRUE.)  
105      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
106      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
107    
108      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
109      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
110      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
111      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
112        ! Ajouter artificiellement les stratus
113    
114      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
115      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
116      logical rnpb      logical rnpb
117      parameter(rnpb=.true.)      parameter(rnpb = .true.)
118    
119      character(len=6), save:: ocean      character(len = 6), save:: ocean
120      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
121    
122      logical ok_ocean      logical ok_ocean
123      SAVE ok_ocean      SAVE ok_ocean
124    
125      !IM "slab" ocean      ! "slab" ocean
126      REAL tslab(klon)    !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
127      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
128      REAL seaice(klon)   !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
129      SAVE seaice      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
     REAL fluxo(klon)    !flux turbulents ocean-glace de mer  
     REAL fluxg(klon)    !flux turbulents ocean-atmosphere  
130    
131      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
132      logical, save:: ok_veget      logical, save:: ok_veget
# Line 141  contains Line 138  contains
138      save ok_instan      save ok_instan
139    
140      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
141      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
142    
143      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
144      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
145      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
146      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
     save q2  
147    
148      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      INTEGER ivap ! indice de traceurs pour vapeur d'eau
149      PARAMETER (ivap=1)      PARAMETER (ivap = 1)
150      INTEGER iliq          ! indice de traceurs pour eau liquide      INTEGER iliq ! indice de traceurs pour eau liquide
151      PARAMETER (iliq=2)      PARAMETER (iliq = 2)
152    
153      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
154      SAVE t_ancien, q_ancien      LOGICAL, save:: ancien_ok
     LOGICAL ancien_ok  
     SAVE ancien_ok  
155    
156      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
157      REAL d_q_dyn(klon, llm)  ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)
158    
159      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
160    
161      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
162    
163      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
164      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
165      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
166      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 174  contains Line 168  contains
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      INTEGER klevp1
171      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
172    
173      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
174      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
175      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
176    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
177      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
178      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
179      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
180    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
181      !IM Amip2      !IM Amip2
182      ! variables a une pression donnee      ! variables a une pression donnee
183    
184      integer nlevSTD      integer nlevSTD
185      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
186      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
187      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
188           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
189           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
190      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
191      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
192           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
193           '70  ', '50  ', '30  ', '20  ', '10  '/           '70 ', '50 ', '30 ', '20 ', '10 '/
   
     real tlevSTD(klon, nlevSTD), qlevSTD(klon, nlevSTD)  
     real rhlevSTD(klon, nlevSTD), philevSTD(klon, nlevSTD)  
     real ulevSTD(klon, nlevSTD), vlevSTD(klon, nlevSTD)  
     real wlevSTD(klon, nlevSTD)  
   
     ! nout : niveau de output des variables a une pression donnee  
     INTEGER nout  
     PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC  
   
     logical oknondef(klon, nlevSTD, nout)  
     real tnondef(klon, nlevSTD, nout)  
     save tnondef  
   
     ! les produits uvSTD, vqSTD, .., T2STD sont calcules  
     ! a partir des valeurs instantannees toutes les 6 h  
     ! qui sont moyennees sur le mois  
   
     real uvSTD(klon, nlevSTD)  
     real vqSTD(klon, nlevSTD)  
     real vTSTD(klon, nlevSTD)  
     real wqSTD(klon, nlevSTD)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
194    
195      ! prw: precipitable water      ! prw: precipitable water
196      real prw(klon)      real prw(klon)
# Line 242  contains Line 200  contains
200      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
201      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
202    
203      INTEGER l, kmax, lmax      INTEGER kmax, lmax
204      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
205      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
206      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
207    
208      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
209      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./
# Line 256  contains Line 214  contains
214      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
215    
216      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
217      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
218    
219      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
220      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
221      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
222    
223      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
224      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &      DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &
225           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
226           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &           'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &
# Line 294  contains Line 252  contains
252      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
253      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
254    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
255      ! Variables propres a la physique      ! Variables propres a la physique
256    
257      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 304  contains Line 259  contains
259      ! "physiq".)      ! "physiq".)
260    
261      REAL radsol(klon)      REAL radsol(klon)
262      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
263    
264      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
265    
266      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
267    
268      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
269      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
270    
271      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
272      SAVE fevap                 ! evaporation      SAVE fevap ! evaporation
273      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
274      SAVE fluxlat      SAVE fluxlat
275    
276      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
277      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
278    
279      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
280    
281      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
282      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
283    
284      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
285      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
286      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
287      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
288    
289      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
290      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 348  contains Line 301  contains
301      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
302    
303      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
304      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
305    
306      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
307      SAVE run_off_lic_0      SAVE run_off_lic_0
308      !KE43      !KE43
309      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
310    
311      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
312      SAVE bas      SAVE bas
313      SAVE top      SAVE top
314    
315      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
316      SAVE Ma      SAVE Ma
317      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
318      SAVE qcondc      SAVE qcondc
319      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
320      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
321    
322      REAL wd(klon) ! sb      REAL wd(klon) ! sb
323      SAVE wd       ! sb      SAVE wd ! sb
324    
325      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
326    
# Line 376  contains Line 329  contains
329      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
330      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
331    
332      !AA  Pour phytrac      !AA Pour phytrac
333      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
334      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
335      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
336      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
337      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
338      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
339      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
340      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
341    
342      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 395  contains Line 348  contains
348      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
349      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
350    
351      !AA      REAL, save:: rain_fall(klon) ! pluie
352      REAL rain_fall(klon) ! pluie      REAL, save:: snow_fall(klon) ! neige
353      REAL snow_fall(klon) ! neige  
     save snow_fall, rain_fall  
     !IM cf FH pour Tiedtke 080604  
354      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
355    
356      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
357      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
358      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
359      SAVE dlw      SAVE dlw
360      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
361      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! Derive de flux (sensible et latente)
# Line 427  contains Line 378  contains
378      !IM      !IM
379      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
380    
381      SAVE pctsrf                 ! sous-fraction du sol      SAVE pctsrf ! sous-fraction du sol
382      REAL albsol(klon)      REAL albsol(klon)
383      SAVE albsol                 ! albedo du sol total      SAVE albsol ! albedo du sol total
384      REAL albsollw(klon)      REAL albsollw(klon)
385      SAVE albsollw                 ! albedo du sol total      SAVE albsollw ! albedo du sol total
386    
387      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
388    
389      ! Declaration des procedures appelees      ! Declaration des procedures appelees
390    
391      EXTERNAL alboc     ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
     EXTERNAL ajsec     ! ajustement sec  
     EXTERNAL clmain    ! couche limite  
392      !KE43      !KE43
393      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3 ! convect4.3
394      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
395      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
396      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
397    
398      ! Variables locales      ! Variables locales
399    
# Line 454  contains Line 402  contains
402    
403      save rnebcon, clwcon      save rnebcon, clwcon
404    
405      REAL rhcl(klon, llm)    ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
406      REAL dialiq(klon, llm)  ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
407      REAL diafra(klon, llm)  ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
408      REAL cldliq(klon, llm)  ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
409      REAL cldfra(klon, llm)  ! fraction nuageuse      REAL cldfra(klon, llm) ! fraction nuageuse
410      REAL cldtau(klon, llm)  ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
411      REAL cldemi(klon, llm)  ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
412    
413      REAL fluxq(klon, llm, nbsrf)   ! flux turbulent d'humidite      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite
414      REAL fluxt(klon, llm, nbsrf)   ! flux turbulent de chaleur      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur
415      REAL fluxu(klon, llm, nbsrf)   ! flux turbulent de vitesse u      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u
416      REAL fluxv(klon, llm, nbsrf)   ! flux turbulent de vitesse v      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v
417    
418      REAL zxfluxt(klon, llm)      REAL zxfluxt(klon, llm)
419      REAL zxfluxq(klon, llm)      REAL zxfluxq(klon, llm)
420      REAL zxfluxu(klon, llm)      REAL zxfluxu(klon, llm)
421      REAL zxfluxv(klon, llm)      REAL zxfluxv(klon, llm)
422    
423      REAL heat(klon, llm)    ! chauffage solaire      ! Le rayonnement n'est pas calculé tous les pas, il faut donc que
424      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! les variables soient rémanentes.
425      REAL cool(klon, llm)    ! refroidissement infrarouge      REAL, save:: heat(klon, llm) ! chauffage solaire
426      REAL cool0(klon, llm)   ! refroidissement infrarouge ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
427      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
428      real sollwdown(klon)    ! downward LW flux at surface      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
429      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)
430        real sollwdown(klon) ! downward LW flux at surface
431        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
432      REAL albpla(klon)      REAL albpla(klon)
433      REAL fsollw(klon, nbsrf)   ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
434      REAL fsolsw(klon, nbsrf)   ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
435      ! Le rayonnement n'est pas calcule tous les pas, il faut donc      SAVE albpla, sollwdown
436      !                      sauvegarder les sorties du rayonnement      SAVE heat0, cool0
     SAVE  heat, cool, albpla, topsw, toplw, solsw, sollw, sollwdown  
     SAVE  topsw0, toplw0, solsw0, sollw0, heat0, cool0  
437    
438      INTEGER itaprad      INTEGER itaprad
439      SAVE itaprad      SAVE itaprad
440    
441      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
442      REAL conv_t(klon, llm) ! convergence de la temperature(K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
443    
444      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut
445      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree
# Line 506  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    
465      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
466    
467      REAL pblh(klon, nbsrf)           ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
468      REAL plcl(klon, nbsrf)           ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
469      REAL capCL(klon, nbsrf)          ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
470      REAL oliqCL(klon, nbsrf)          ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
471      REAL cteiCL(klon, nbsrf)          ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
472      REAL pblt(klon, nbsrf)          ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite
473      REAL therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
474      REAL trmb1(klon, nbsrf)          ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
475      REAL trmb2(klon, nbsrf)          ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
476      REAL trmb3(klon, nbsrf)          ! Point Omega      REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega
477      ! Grdeurs de sorties      ! Grdeurs de sorties
478      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
479      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
480      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
481      REAL s_trmb3(klon)      REAL s_trmb3(klon)
482    
483      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel :
484    
485      REAL upwd(klon, llm)      ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
486      REAL dnwd(klon, llm)      ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
487      REAL dnwd0(klon, llm)     ! unsaturated downdraft mass flux      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux
488      REAL tvp(klon, llm)       ! virtual temp of lifted parcel      REAL tvp(klon, llm) ! virtual temp of lifted parcel
489      REAL cape(klon)           ! CAPE      REAL cape(klon) ! CAPE
490      SAVE cape      SAVE cape
491    
492      REAL pbase(klon)          ! cloud base pressure      REAL pbase(klon) ! cloud base pressure
493      SAVE pbase      SAVE pbase
494      REAL bbase(klon)          ! cloud base buoyancy      REAL bbase(klon) ! cloud base buoyancy
495      SAVE bbase      SAVE bbase
496      REAL rflag(klon)          ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
497      INTEGER iflagctrl(klon)          ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
498      ! -- convect43:      ! -- convect43:
499      INTEGER ntra              ! nb traceurs pour convect4.3      INTEGER ntra ! nb traceurs pour convect4.3
500      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
501      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
502    
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 570  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 605  contains Line 551  contains
551    
552      logical ptconv(klon, llm)      logical ptconv(klon, llm)
553    
554      ! Variables locales pour effectuer les appels en serie      ! 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 621  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)
   
     REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique  
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
571    
572        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)
574    
575      INTEGER, SAVE:: nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
# Line 637  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
594      SAVE      d_h_vcol_phy      REAL zero_v(klon)
595      REAL      zero_v(klon)      CHARACTER(LEN = 15) tit
596      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
     INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.  
     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  
602      !IM: t2m, q2m, u10m, v10m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)   !temperature, humidite a 2m  
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
605      REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille
606      !jq   Aerosol effects (Johannes Quaas, 27/11/2003)      !jq Aerosol effects (Johannes Quaas, 27/11/2003)
607      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]
608    
609      REAL sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
610      ! (SO4 aerosol concentration [ug/m3] (pre-industrial value))      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)
     SAVE sulfate_pi  
611    
612      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
613      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! (Cloud optical thickness for pre-industrial (pi) aerosols)
614    
615      REAL re(klon, llm)       ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
616      REAL fl(klon, llm)  ! denominator of re      REAL fl(klon, llm) ! denominator of re
617    
618      ! Aerosol optical properties      ! Aerosol optical properties
619      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
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=T -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=T ->      ! ok_aie = True ->
627      !        ok_ade=T -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    
632      ! Parameters      ! Parameters
633      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not      LOGICAL, save:: ok_ade ! apply aerosol direct effect
634      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      LOGICAL, save:: ok_aie ! Apply aerosol indirect effect
635        REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
636    
637      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE bl95_b0, bl95_b1
638      SAVE u10m      SAVE u10m
639      SAVE v10m      SAVE v10m
640      SAVE t2m      SAVE t2m
# Line 714  contains Line 654  contains
654      SAVE d_v_con      SAVE d_v_con
655      SAVE rnebcon0      SAVE rnebcon0
656      SAVE clwcon0      SAVE clwcon0
     SAVE pblh  
     SAVE plcl  
     SAVE capCL  
     SAVE oliqCL  
     SAVE cteiCL  
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
657    
658      real zmasse(klon, llm)      real zmasse(klon, llm)
659      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
# Line 734  contains Line 664  contains
664    
665      modname = 'physiq'      modname = 'physiq'
666      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
667         DO i=1, klon         DO i = 1, klon
668            zero_v(i)=0.            zero_v(i) = 0.
669         END DO         END DO
670      END IF      END IF
671      ok_sync=.TRUE.      ok_sync = .TRUE.
672      IF (nq  <  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)
675      ENDIF      ENDIF
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 771  contains Line 701  contains
701         rnebcon = 0.0         rnebcon = 0.0
702         clwcon = 0.0         clwcon = 0.0
703    
704         pblh   =0.        ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
705         plcl   =0.        ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
706         capCL  =0.        ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
707         oliqCL =0.        ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
708         cteiCL =0.        ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
709         pblt   =0.        ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
710         therm  =0.         therm =0.
711         trmb1  =0.        ! deep_cape         trmb1 =0. ! deep_cape
712         trmb2  =0.        ! inhibition         trmb2 =0. ! inhibition
713         trmb3  =0.        ! Point Omega         trmb3 =0. ! Point Omega
714    
715         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
716    
717         ! appel a la lecture du run.def physique         ! Appel à la lecture du run.def physique
718           call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
719         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &              fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
720              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, &
             iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &  
             ok_ade, ok_aie,  &  
             bl95_b0, bl95_b1, &  
721              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
722    
723         ! Initialiser les compteurs:         ! Initialiser les compteurs:
# Line 799  contains Line 726  contains
726         itap = 0         itap = 0
727         itaprad = 0         itaprad = 0
728         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
729              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
730              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
731              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
732              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
             t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &  
             run_off_lic_0)  
733    
734         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
735         q2(:, :, :)=1.e-8         q2 = 1.e-8
736    
737         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
738    
739         ! on remet le calendrier a zero         ! on remet le calendrier a zero
740         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
# Line 817  contains Line 742  contains
742         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
743    
744         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
745            ok_ocean=.TRUE.            ok_ocean = .TRUE.
746         ENDIF         ENDIF
747    
748         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
749              ok_region)              ok_region)
750    
751         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
752            print *,'Nbre d appels au rayonnement insuffisant'            print *, 'Nbre d appels au rayonnement insuffisant'
753            print *,"Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
754            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
755            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
756         ENDIF         ENDIF
757         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  
758    
759         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
760         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
761              print *, "Convection de Kerry Emanuel 4.3"
762    
           print *,"*** Convection de Kerry Emanuel 4.3  "  
   
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG  
763            DO i = 1, klon            DO i = 1, klon
764               ibas_con(i) = 1               ibas_con(i) = 1
765               itop_con(i) = 1               itop_con(i) = 1
766            ENDDO            ENDDO
           !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>END  
   
767         ENDIF         ENDIF
768    
769         IF (ok_orodr) THEN         IF (ok_orodr) THEN
770            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
771            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(paprs, play)
772         else         else
773            rugoro = 0.            rugoro = 0.
774         ENDIF         ENDIF
775    
776         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
777         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
778    
779         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
780         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
781         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
782         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
783         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
784    
785         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
786    
787         npas = 0         npas = 0
788         nexca = 0         nexca = 0
789    
790         print *,'AVANT HIST IFLAG_CON=', iflag_con         ! Initialisation des sorties
   
        !   Initialisation des sorties  
791    
792         call ini_histhf(pdtphys, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
793         call ini_histday(pdtphys, ok_journe, nid_day, nq)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
794         call ini_histins(pdtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
795         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
796         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
797         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
798      ENDIF test_firstcal      ENDIF test_firstcal
799    
800      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 885  contains Line 802  contains
802      DO i = 1, klon      DO i = 1, klon
803         d_ps(i) = 0.0         d_ps(i) = 0.0
804      ENDDO      ENDDO
805      DO k = 1, llm      DO iq = 1, nqmx
        DO i = 1, klon  
           d_t(i, k) = 0.0  
           d_u(i, k) = 0.0  
           d_v(i, k) = 0.0  
        ENDDO  
     ENDDO  
     DO iq = 1, nq  
806         DO k = 1, llm         DO k = 1, llm
807            DO i = 1, klon            DO i = 1, klon
808               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
809            ENDDO            ENDDO
810         ENDDO         ENDDO
811      ENDDO      ENDDO
812      da=0.      da = 0.
813      mp=0.      mp = 0.
814      phi(:, :, :)=0.      phi = 0.
815    
816      ! 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 :
817    
818      DO k = 1, llm      DO k = 1, llm
819         DO i = 1, klon         DO i = 1, klon
820            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
821            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
822            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
823            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
824            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
825            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
826         ENDDO         ENDDO
827      ENDDO      ENDDO
828      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
829         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
830      ELSE      ELSE
831         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
832      ENDIF      ENDIF
# Line 931  contains Line 841  contains
841      ENDDO      ENDDO
842    
843      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
844         ztit='after dynamic'         tit = 'after dynamics'
845         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
846              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
847              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
848         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
849         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
850         !     est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
851         !     Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
852         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
853              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
854              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
855              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
856      END IF      END IF
857    
858      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
859      IF (ancien_ok) THEN      IF (ancien_ok) THEN
860         DO k = 1, llm         DO k = 1, llm
861            DO i = 1, klon            DO i = 1, klon
862               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys               d_t_dyn(i, k) = (t_seri(i, k) - t_ancien(i, k)) / dtphys
863               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys               d_q_dyn(i, k) = (q_seri(i, k) - q_ancien(i, k)) / dtphys
864            ENDDO            ENDDO
865         ENDDO         ENDDO
866      ELSE      ELSE
# Line 966  contains Line 874  contains
874      ENDIF      ENDIF
875    
876      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
877      DO k = 1, llm      DO k = 1, llm
878         DO i = 1, klon         DO i = 1, klon
879            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
880         ENDDO         ENDDO
881      ENDDO      ENDDO
882    
883      ! Verifier les temperatures      ! Check temperatures:
   
884      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
885    
886      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
887      itap = itap + 1      itap = itap + 1
888      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
889      if (julien == 0) julien = 360      if (julien == 0) julien = 360
890    
891      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
892    
893      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     ! Prescrire l'ozone et calculer l'albedo sur l'ocean.  
894    
895      if (nq >= 5) then      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
896         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3      wo = ozonecm(REAL(julien), paprs)
     else IF (MOD(itap - 1, lmt_pas) == 0) THEN  
        wo = ozonecm(REAL(julien), paprs)  
     ENDIF  
   
     ! Re-evaporer l'eau liquide nuageuse  
897    
898      DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
899        DO k = 1, llm
900         DO i = 1, klon         DO i = 1, klon
901            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
902            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
903            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  
904            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
905         ENDDO         ENDDO
906      ENDDO      ENDDO
907        ql_seri = 0.
908    
909      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
910         ztit='after reevap'         tit = 'after reevap'
911         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
912              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
913              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
914         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
915              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
916              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
917    
918      END IF      END IF
919    
# Line 1043  contains Line 937  contains
937    
938      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
939      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
940         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
941         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
942      ELSE      ELSE
943         rmu0 = -999.999         rmu0 = -999.999
944      ENDIF      ENDIF
945    
946      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
947      albsol(:)=0.      albsol(:) = 0.
948      albsollw(:)=0.      albsollw(:) = 0.
949      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
950         DO i = 1, klon         DO i = 1, klon
951            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1059  contains Line 953  contains
953         ENDDO         ENDDO
954      ENDDO      ENDDO
955    
956      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
957      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
958    
959      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1072  contains Line 966  contains
966    
967      fder = dlw      fder = dlw
968    
969      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
970           t_seri, q_seri, u_seri, v_seri, &  
971           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
972           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
973           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
974           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
975           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
976           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
977           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
978           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
979           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
980           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
981           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
982           q2, dsens, devap, &      ! Incrémentation des flux
983           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
984           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
985           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
986           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
987           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
988      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
989         DO k = 1, llm         DO k = 1, llm
990            DO i = 1, klon            DO i = 1, klon
991               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
992                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
993               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
994                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
995               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
996                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
997               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
998                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
999            END DO            END DO
1000         END DO         END DO
1001      END DO      END DO
# Line 1128  contains Line 1015  contains
1015      ENDDO      ENDDO
1016    
1017      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1018         ztit='after clmain'         tit = 'after clmain'
1019         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1020              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1021              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1022         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1023              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1024              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1025      END IF      END IF
1026    
1027      ! Incrementer la temperature du sol      ! Update surface temperature:
1028    
1029      DO i = 1, klon      DO i = 1, klon
1030         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1163  contains Line 1048  contains
1048         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1049         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1050    
1051         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1052              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1053              THEN              THEN
1054            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1055                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1056         ENDIF         ENDIF
1057      ENDDO      ENDDO
# Line 1181  contains Line 1066  contains
1066            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1067            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1068            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1069            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1070                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1071            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1072            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)
# Line 1200  contains Line 1085  contains
1085    
1086      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1087         DO i = 1, klon         DO i = 1, klon
1088            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1089    
1090            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1091            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1092            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1093            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1094            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1095            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1096                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1097            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1098            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1099            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1100            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1101            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1102            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1103            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1104            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1105            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1106            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1107         ENDDO         ENDDO
1108      ENDDO      ENDDO
1109    
# Line 1232  contains Line 1117  contains
1117    
1118      DO k = 1, llm      DO k = 1, llm
1119         DO i = 1, klon         DO i = 1, klon
1120            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1121                 + d_q_vdf(i, k)/pdtphys                 + d_q_vdf(i, k)/dtphys
1122            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1123                 + d_t_vdf(i, k)/pdtphys                 + d_t_vdf(i, k)/dtphys
1124         ENDDO         ENDDO
1125      ENDDO      ENDDO
1126      IF (check) THEN      IF (check) THEN
1127         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1128         print *, "avantcon=", za         print *, "avantcon = ", za
1129      ENDIF      ENDIF
1130      zx_ajustq = .FALSE.      zx_ajustq = iflag_con == 2
     IF (iflag_con == 2) zx_ajustq=.TRUE.  
1131      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1132         DO i = 1, klon         DO i = 1, klon
1133            z_avant(i) = 0.0            z_avant(i) = 0.0
1134         ENDDO         ENDDO
1135         DO k = 1, llm         DO k = 1, llm
1136            DO i = 1, klon            DO i = 1, klon
1137               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)) &
1138                    *zmasse(i, k)                    *zmasse(i, k)
1139            ENDDO            ENDDO
1140         ENDDO         ENDDO
1141      ENDIF      ENDIF
1142      IF (iflag_con == 1) THEN  
1143         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1144      ELSE IF (iflag_con == 2) THEN      case (2)
1145         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1146              conv_t, conv_q, zxfluxq(1, 1), omega, &              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1147              d_t_con, d_q_con, rain_con, snow_con, &              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1148              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmflxs)
             kcbot, kctop, kdtop, pmflxr, pmflxs)  
1149         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1150         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1151         DO i = 1, klon         DO i = 1, klon
1152            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1153            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1154         ENDDO         ENDDO
1155      ELSE IF (iflag_con >= 3) THEN      case (3:)
1156         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1157         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1158         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1159         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1160         ntra = 1         ntra = 1
1161         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1162         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1163    
1164         IF (ok_cvl) THEN ! new driver for convectL         CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &
1165            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &              v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1166                 u_seri, v_seri, tr_seri, ntra, &              d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &
1167                 ema_work1, ema_work2, &              upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &
1168                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &              dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
1169                 rain_con, snow_con, ibas_con, itop_con, &              da, phi, mp)
1170                 upwd, dnwd, dnwd0, &         clwcon0 = qcondc
1171                 Ma, cape, tvp, iflagctrl, &         pmfu = upwd + dnwd
                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &  
                pmflxr, pmflxs, &  
                da, phi, mp)  
   
           clwcon0=qcondc  
           pmfu=upwd+dnwd  
        ELSE ! ok_cvl  
           ! MAF conema3 ne contient pas les traceurs  
           CALL conema3 (pdtphys, paprs, pplay, 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  
1172    
1173         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1174            do i = 1, klon            do i = 1, klon
1175               wd(i)=0.0               wd(i) = 0.0
1176            enddo            enddo
1177         ENDIF         ENDIF
1178    
1179         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1180    
1181         DO k = 1, llm         DO k = 1, llm
1182            DO i = 1, klon            DO i = 1, klon
1183               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1184               IF (thermcep) THEN               IF (thermcep) THEN
1185                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1186                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1187                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1188                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1189                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1190               ELSE               ELSE
1191                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1192                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1193                  ELSE                  ELSE
1194                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1195                  ENDIF                  ENDIF
1196               ENDIF               ENDIF
1197               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1198            ENDDO            ENDDO
1199         ENDDO         ENDDO
1200    
1201         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1202         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1203         call clouds_gno &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1204              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              rnebcon0)
1205      ELSE      case default
1206         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1207         stop 1         stop 1
1208      ENDIF      END select
1209    
1210      DO k = 1, llm      DO k = 1, llm
1211         DO i = 1, klon         DO i = 1, klon
# Line 1353  contains Line 1217  contains
1217      ENDDO      ENDDO
1218    
1219      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1220         ztit='after convect'         tit = 'after convect'
1221         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1222              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1223              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1224         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1225              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec, &
1226              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1227      END IF      END IF
1228    
1229      IF (check) THEN      IF (check) THEN
1230         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1231         print *,"aprescon=", za         print *, "aprescon = ", za
1232         zx_t = 0.0         zx_t = 0.0
1233         za = 0.0         za = 0.0
1234         DO i = 1, klon         DO i = 1, klon
# Line 1374  contains Line 1236  contains
1236            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1237                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1238         ENDDO         ENDDO
1239         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1240         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1241      ENDIF      ENDIF
1242      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1243         DO i = 1, klon         DO i = 1, klon
# Line 1383  contains Line 1245  contains
1245         ENDDO         ENDDO
1246         DO k = 1, llm         DO k = 1, llm
1247            DO i = 1, klon            DO i = 1, klon
1248               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)) &
1249                    *zmasse(i, k)                    *zmasse(i, k)
1250            ENDDO            ENDDO
1251         ENDDO         ENDDO
1252         DO i = 1, klon         DO i = 1, klon
1253            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1254                 /z_apres(i)                 /z_apres(i)
1255         ENDDO         ENDDO
1256         DO k = 1, llm         DO k = 1, llm
1257            DO i = 1, klon            DO i = 1, klon
1258               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  
1259                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1260               ENDIF               ENDIF
1261            ENDDO            ENDDO
1262         ENDDO         ENDDO
1263      ENDIF      ENDIF
1264      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1265    
1266      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1267    
1268      d_t_ajs=0.      d_t_ajs = 0.
1269      d_u_ajs=0.      d_u_ajs = 0.
1270      d_v_ajs=0.      d_v_ajs = 0.
1271      d_q_ajs=0.      d_q_ajs = 0.
1272      fm_therm=0.      fm_therm = 0.
1273      entr_therm=0.      entr_therm = 0.
1274    
1275      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1276           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1277           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
     if(iflag_thermals < 0) then  
        !  Rien  
        IF(prt_level>9)print *,'pas de convection'  
     else if(iflag_thermals == 0) then  
        !  Ajustement sec  
        IF(prt_level>9)print *,'ajsec'  
        CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)  
1278         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1279         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1280      else      else
1281         !  Thermiques         ! Thermiques
1282         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1283              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
        call calltherm(pdtphys &  
             , pplay, paprs, pphi &  
             , u_seri, v_seri, t_seri, q_seri &  
             , d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs &  
             , fm_therm, entr_therm)  
1284      endif      endif
1285    
1286      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1287         ztit='after dry_adjust'         tit = 'after dry_adjust'
1288         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1289              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1290              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1291      END IF      END IF
1292    
1293      !  Caclul des ratqs      ! Caclul des ratqs
1294    
1295      !   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
1296      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1297      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1298         do k=1, llm         do k = 1, llm
1299            do i=1, klon            do i = 1, klon
1300               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1301                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1302                       +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)
1303               else               else
1304                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1305               endif               endif
1306            enddo            enddo
1307         enddo         enddo
1308      endif      endif
1309    
1310      !   ratqs stables      ! ratqs stables
1311      do k=1, llm      do k = 1, llm
1312         do i=1, klon         do i = 1, klon
1313            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1314                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1315         enddo         enddo
1316      enddo      enddo
1317    
1318      !  ratqs final      ! ratqs final
1319      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1320         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1321         !   ratqs final         ! ratqs final
1322         !   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
1323         !   relaxation des ratqs         ! relaxation des ratqs
1324         facteur=exp(-pdtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1325         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1326         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1327      else      else
1328         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1329         ratqs=ratqss         ratqs = ratqss
1330      endif      endif
1331    
1332      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1333      ! et le processus de precipitation      ! précipitation :
1334      CALL fisrtilp(pdtphys, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1335           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1336           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1337           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1338    
1339      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1340      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1503  contains Line 1349  contains
1349      ENDDO      ENDDO
1350      IF (check) THEN      IF (check) THEN
1351         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1352         print *,"apresilp=", za         print *, "apresilp = ", za
1353         zx_t = 0.0         zx_t = 0.0
1354         za = 0.0         za = 0.0
1355         DO i = 1, klon         DO i = 1, klon
# Line 1511  contains Line 1357  contains
1357            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1358                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1359         ENDDO         ENDDO
1360         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1361         print *,"Precip=", zx_t         print *, "Precip = ", zx_t
1362      ENDIF      ENDIF
1363    
1364      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1365         ztit='after fisrt'         tit = 'after fisrt'
1366         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1367              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1368              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1369         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1370              , zero_v, zero_v, zero_v, zero_v, zero_v &              zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec, &
1371              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1372      END IF      END IF
1373    
1374      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1375    
1376      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1377    
1378      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon <= -1) THEN
1379         snow_tiedtke=0.         ! seulement pour Tiedtke
1380           snow_tiedtke = 0.
1381         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1382            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1383         else         else
1384            rain_tiedtke=0.            rain_tiedtke = 0.
1385            do k=1, llm            do k = 1, llm
1386               do i=1, klon               do i = 1, klon
1387                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1388                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1389                          *zmasse(i, k)                          *zmasse(i, k)
1390                  endif                  endif
1391               enddo               enddo
# Line 1548  contains Line 1393  contains
1393         endif         endif
1394    
1395         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1396         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1397              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1398              diafra, dialiq)              diafra, dialiq)
1399         DO k = 1, llm         DO k = 1, llm
1400            DO i = 1, klon            DO i = 1, klon
1401               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1402                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1403                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1404               ENDIF               ENDIF
1405            ENDDO            ENDDO
1406         ENDDO         ENDDO
   
1407      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1408         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1409         ! 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
1410         ! facttemps         ! facttemps
1411         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1412         do k=1, llm         do k = 1, llm
1413            do i=1, klon            do i = 1, klon
1414               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1415               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)) &
1416                    then                    then
1417                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1418                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1419               endif               endif
1420            enddo            enddo
1421         enddo         enddo
1422    
1423         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1424         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1425         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1426      ENDIF      ENDIF
1427    
1428      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1429    
1430      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1431         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1432         DO k = 1, llm         DO k = 1, llm
1433            DO i = 1, klon            DO i = 1, klon
1434               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1435                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1436                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1437               ENDIF               ENDIF
# Line 1597  contains Line 1440  contains
1440      ENDIF      ENDIF
1441    
1442      ! Precipitation totale      ! Precipitation totale
   
1443      DO i = 1, klon      DO i = 1, klon
1444         rain_fall(i) = rain_con(i) + rain_lsc(i)         rain_fall(i) = rain_con(i) + rain_lsc(i)
1445         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
1446      ENDDO      ENDDO
1447    
1448      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &
1449         ztit="after diagcld"           dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1450         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
             , t_seri, q_seri, 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  
1451    
1452        ! Humidité relative pour diagnostic :
1453      DO k = 1, llm      DO k = 1, llm
1454         DO i = 1, klon         DO i = 1, klon
1455            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1456            IF (thermcep) THEN            IF (thermcep) THEN
1457               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1458               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1459               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1460               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1461               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1462            ELSE            ELSE
1463               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1464                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1465               ELSE               ELSE
1466                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1467               ENDIF               ENDIF
1468            ENDIF            ENDIF
1469            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1470            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1471         ENDDO         ENDDO
1472      ENDDO      ENDDO
1473      !jq - introduce the aerosol direct and first indirect radiative forcings  
1474      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1475      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003
1476        IF (ok_ade .OR. ok_aie) THEN
1477         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1478         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1479         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1480    
1481         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1482         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1483              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1484      ELSE      ELSE
1485         tau_ae(:, :, :)=0.0         tau_ae = 0.
1486         piz_ae(:, :, :)=0.0         piz_ae = 0.
1487         cg_ae(:, :, :)=0.0         cg_ae = 0.
1488      ENDIF      ENDIF
1489    
1490      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
     ! parametres pour diagnostiques:  
   
1491      if (ok_newmicro) then      if (ok_newmicro) then
1492         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1493              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1494              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1495              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1496      else      else
1497         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1498              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1499              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1500      endif      endif
1501    
1502      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1503      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1504         DO i = 1, klon         DO i = 1, klon
1505            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1684  contains Line 1511  contains
1511                 + falblw(i, is_ter) * pctsrf(i, is_ter) &                 + falblw(i, is_ter) * pctsrf(i, is_ter) &
1512                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1513         ENDDO         ENDDO
1514         ! nouveau rayonnement (compatible Arpege-IFS):         ! Rayonnement (compatible Arpege-IFS) :
1515         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1516              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1517              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1518              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1519              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1520              topsw, toplw, solsw, sollw, &              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
             sollwdown, &  
             topsw0, toplw0, solsw0, sollw0, &  
             lwdn0, lwdn, lwup0, lwup,  &  
             swdn0, swdn, swup0, swup, &  
             ok_ade, ok_aie, & ! new for aerosol radiative effects  
             tau_ae, piz_ae, cg_ae, &  
             topswad, solswad, &  
             cldtaupi, &  
             topswai, solswai)  
1521         itaprad = 0         itaprad = 0
1522      ENDIF      ENDIF
1523      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1708  contains Line 1526  contains
1526    
1527      DO k = 1, llm      DO k = 1, llm
1528         DO i = 1, klon         DO i = 1, klon
1529            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)) * pdtphys/86400.  
1530         ENDDO         ENDDO
1531      ENDDO      ENDDO
1532    
1533      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1534         ztit='after rad'         tit = 'after rad'
1535         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1536              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1537              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1538         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &
1539              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1540              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1541      END IF      END IF
1542    
1543      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1544      DO i = 1, klon      DO i = 1, klon
1545         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1546         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1738  contains Line 1552  contains
1552         ENDDO         ENDDO
1553      ENDDO      ENDDO
1554    
1555      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1556    
1557      DO i = 1, klon      DO i = 1, klon
1558         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1559      ENDDO      ENDDO
1560    
1561      !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:  
1562    
1563      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1564         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1565         igwd=0         igwd = 0
1566         DO i=1, klon         DO i = 1, klon
1567            itest(i)=0            itest(i) = 0
1568            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
1569               itest(i)=1               itest(i) = 1
1570               igwd=igwd+1               igwd = igwd + 1
1571               idx(igwd)=i               idx(igwd) = i
1572            ENDIF            ENDIF
1573         ENDDO         ENDDO
1574    
1575         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1576              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1577              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)  
1578    
1579         !  ajout des tendances         ! ajout des tendances
1580         DO k = 1, llm         DO k = 1, llm
1581            DO i = 1, klon            DO i = 1, klon
1582               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_oro(i, k)
# Line 1778  contains Line 1587  contains
1587      ENDIF      ENDIF
1588    
1589      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1590           ! Sélection des points pour lesquels le schéma est actif :
1591         !  selection des points pour lesquels le shema est actif:         igwd = 0
1592         igwd=0         DO i = 1, klon
1593         DO i=1, klon            itest(i) = 0
1594            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1595            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1596               itest(i)=1               igwd = igwd + 1
1597               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1598            ENDIF            ENDIF
1599         ENDDO         ENDDO
1600    
1601         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1602              rlat, zmea, zstd, zpic, &              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &
             itest, &  
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrli, zvstrli, &  
1603              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1604    
1605         !  ajout des tendances         ! Ajout des tendances :
1606         DO k = 1, llm         DO k = 1, llm
1607            DO i = 1, klon            DO i = 1, klon
1608               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 1805  contains Line 1610  contains
1610               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_lif(i, k)
1611            ENDDO            ENDDO
1612         ENDDO         ENDDO
1613        ENDIF
1614    
1615      ENDIF ! fin de test sur ok_orolf      ! Stress nécessaires : toute la physique
   
     ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE  
1616    
1617      DO i = 1, klon      DO i = 1, klon
1618         zustrph(i)=0.         zustrph(i) = 0.
1619         zvstrph(i)=0.         zvstrph(i) = 0.
1620      ENDDO      ENDDO
1621      DO k = 1, llm      DO k = 1, llm
1622         DO i = 1, klon         DO i = 1, klon
1623            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)            zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &
1624            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)                 * zmasse(i, k)
1625              zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &
1626                   * zmasse(i, k)
1627         ENDDO         ENDDO
1628      ENDDO      ENDDO
1629    
1630      !IM calcul composantes axiales du moment angulaire et couple des montagnes      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &
1631             zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1632      CALL aaam_bud(27, klon, llm, gmtime, &  
1633           ra, rg, romega, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1634           rlat, rlon, pphis, &           2, dtphys, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, &
1635           zustrdr, zustrli, zustrph, &           d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1636           zvstrdr, zvstrli, zvstrph, &  
1637           paprs, u, v, &      ! Calcul des tendances traceurs
1638           aam, torsfc)      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1639             dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
1640      IF (if_ebil >= 2) THEN           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1641         ztit='after orography'           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1642         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
             , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &  
             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)  
     END IF  
   
     !AA Installation de l'interface online-offline pour traceurs  
   
     !   Calcul  des tendances traceurs  
   
     call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &  
          pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &  
          pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &  
          frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &  
          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &  
          psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)  
1643    
1644      IF (offline) THEN      IF (offline) THEN
1645           call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1646         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1647         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             t, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             fm_therm, entr_therm, &  
             ycoefh, yu1, yv1, ftsol, pctsrf, &  
             frac_impa, frac_nucl, &  
             pphis, airephy, pdtphys, itap)  
   
1648      ENDIF      ENDIF
1649    
1650      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1651        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1652             ue, uq)
1653    
1654      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1655    
1656      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
          t_seri, q_seri, u_seri, v_seri, zphi, &  
1657           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1658    
1659      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1660    
1661      !+jld ec_conser      ! conversion Ec -> E thermique
1662      DO k = 1, llm      DO k = 1, llm
1663         DO i = 1, klon         DO i = 1, klon
1664            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1665            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1666                 *(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)
1667            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)
1668            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1669         END DO         END DO
1670      END DO      END DO
1671      !-jld ec_conser  
1672      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1673         ztit='after physic'         tit = 'after physic'
1674         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1675              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &              ql_seri, qs_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_qw, &
1676              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1677         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1678         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1679         !     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.
1680         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1681         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1682              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1683              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1684    
1685         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1686    
1687      END IF      END IF
1688    
1689      !   SORTIES      ! SORTIES
1690    
1691      !cc prw = eau precipitable      !cc prw = eau precipitable
1692      DO i = 1, klon      DO i = 1, klon
# Line 1919  contains Line 1700  contains
1700    
1701      DO k = 1, llm      DO k = 1, llm
1702         DO i = 1, klon         DO i = 1, klon
1703            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1704            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1705            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1706            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys            d_qx(i, k, ivap) = (q_seri(i, k) - qx(i, k, ivap)) / dtphys
1707            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys            d_qx(i, k, iliq) = (ql_seri(i, k) - qx(i, k, iliq)) / dtphys
1708         ENDDO         ENDDO
1709      ENDDO      ENDDO
1710    
1711      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1712         DO iq = 3, nq         DO iq = 3, nqmx
1713            DO  k = 1, llm            DO k = 1, llm
1714               DO  i = 1, klon               DO i = 1, klon
1715                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys
1716               ENDDO               ENDDO
1717            ENDDO            ENDDO
1718         ENDDO         ENDDO
# Line 1945  contains Line 1726  contains
1726         ENDDO         ENDDO
1727      ENDDO      ENDDO
1728    
1729      !   Ecriture des sorties      ! Ecriture des sorties
1730      call write_histhf      call write_histhf
1731      call write_histday      call write_histday
1732      call write_histins      call write_histins
# Line 1953  contains Line 1734  contains
1734      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1735      IF (lafin) THEN      IF (lafin) THEN
1736         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1737         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1738              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1739              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1740              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1741              radsol, frugs, agesno, &              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
             zmea, zstd, zsig, zgam, zthe, zpic, zval, &  
             t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)  
1742      ENDIF      ENDIF
1743    
1744        firstcal = .FALSE.
1745    
1746    contains    contains
1747    
1748      subroutine write_histday      subroutine write_histday
1749    
1750        use grid_change, only: gr_phy_write_3d        use gr_phy_write_3d_m, only: gr_phy_write_3d
1751        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1752    
1753        !------------------------------------------------        !------------------------------------------------
1754    
1755        if (ok_journe) THEN        if (ok_journe) THEN
1756           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1757           if (nq <= 4) then           if (nqmx <= 4) then
1758              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1759                   gr_phy_write_3d(wo) * 1e3)                   gr_phy_write_3d(wo) * 1e3)
1760              ! (convert "wo" from kDU to DU)              ! (convert "wo" from kDU to DU)
# Line 1989  contains Line 1770  contains
1770    
1771      subroutine write_histhf      subroutine write_histhf
1772    
1773        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, version 1.5 2005/05/25 13:10:09
1774    
1775        !------------------------------------------------        !------------------------------------------------
1776    
# Line 2005  contains Line 1786  contains
1786    
1787      subroutine write_histins      subroutine write_histins
1788    
1789        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1790    
1791        real zout        real zout
1792        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
1793    
1794        !--------------------------------------------------        !--------------------------------------------------
1795    
1796        IF (ok_instan) THEN        IF (ok_instan) THEN
1797           ! Champs 2D:           ! Champs 2D:
1798    
1799           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1800           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1801           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1802    
1803           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1804           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)
1805           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1806    
1807           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1808           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)
1809           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1810    
1811           DO i = 1, klon           DO i = 1, klon
1812              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1813           ENDDO           ENDDO
1814           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)
1815           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1816    
1817           DO i = 1, klon           DO i = 1, klon
1818              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1819           ENDDO           ENDDO
1820           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)
1821           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1822    
1823           DO i = 1, klon           DO i = 1, klon
1824              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1825           ENDDO           ENDDO
1826           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)
1827           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1828    
1829           DO i = 1, klon           DO i = 1, klon
1830              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1831           ENDDO           ENDDO
1832           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)
1833           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1834    
1835           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)
1836           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1837           !ccIM           !ccIM
1838           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)
1839           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1840    
1841           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)
1842           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1843    
1844           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)
1845           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1846    
1847           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)
1848           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1849    
1850           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)
1851           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1852    
1853           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)
1854           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1855    
1856           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)
1857           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1858    
1859           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)
1860           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1861    
1862           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)
1863           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1864    
1865           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)
1866           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1867    
1868           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)
1869           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1870    
1871           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)
1872           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
1873    
1874           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)
1875           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1876    
1877           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1878           !     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)
1879           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)
1880           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1881    
1882           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)
1883           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1884    
1885           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)
1886           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
1887    
1888           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)
1889           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
1890    
1891           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)
1892           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
1893    
1894           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)
1895           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
1896    
1897           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1898              !XXX              !XXX
1899              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1900              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)
1901              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1902                   zx_tmp_2d)                   zx_tmp_2d)
1903    
1904              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1905              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)
1906              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1907                   zx_tmp_2d)                   zx_tmp_2d)
1908    
1909              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1910              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)
1911              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1912                   zx_tmp_2d)                   zx_tmp_2d)
1913    
1914              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1915              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1916              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1917                   zx_tmp_2d)                   zx_tmp_2d)
1918    
1919              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1920              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)
1921              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1922                   zx_tmp_2d)                   zx_tmp_2d)
1923    
1924              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1925              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)
1926              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1927                   zx_tmp_2d)                   zx_tmp_2d)
1928    
1929              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1930              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)
1931              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1932                   zx_tmp_2d)                   zx_tmp_2d)
1933    
1934              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1935              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)
1936              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1937                   zx_tmp_2d)                   zx_tmp_2d)
1938    
1939              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1940              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)
1941              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1942                   zx_tmp_2d)                   zx_tmp_2d)
1943    
1944           END DO           END DO
1945           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)
1946           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1947           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)
1948           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1949    
1950           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)
1951           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
1952    
          !IM cf. AM 081204 BEG  
   
1953           !HBTM2           !HBTM2
1954    
1955           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)
1956           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
1957    
1958           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)
1959           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1960    
1961           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)
1962           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
1963    
1964           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)
1965           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
1966    
1967           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)
1968           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
1969    
1970           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)
1971           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
1972    
1973           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)
1974           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
1975    
1976           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)
1977           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
1978    
1979           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)
1980           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
1981    
1982           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)
1983           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
1984    
          !IM cf. AM 081204 END  
   
1985           ! Champs 3D:           ! Champs 3D:
1986    
1987           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)
1988           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
1989    
1990           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)
1991           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
1992    
1993           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)
1994           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
1995    
1996           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)
1997           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
1998    
1999           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
2000           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2001    
2002           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)
2003           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2004    
2005           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)
2006           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
2007    
2008           if (ok_sync) then           if (ok_sync) then
# Line 2239  contains Line 2016  contains
2016    
2017      subroutine write_histhf3d      subroutine write_histhf3d
2018    
2019        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, version 1.2 2005/05/25 13:10:09
2020    
2021        integer itau_w  ! pas de temps ecriture        integer itau_w ! pas de temps ecriture
2022    
2023        !-------------------------------------------------------        !-------------------------------------------------------
2024    
# Line 2249  contains Line 2026  contains
2026    
2027        ! Champs 3D:        ! Champs 3D:
2028    
2029        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)
2030        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2031    
2032        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)
2033        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2034    
2035        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)
2036        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2037    
2038        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)
2039        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
2040    
2041        if (nbtr >= 3) then        if (nbtr >= 3) then
2042           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), &
2043                zx_tmp_3d)                zx_tmp_3d)
2044           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2045        end if        end if
Legend:
Removed from v.22  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.21