/[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 13 by guez, Fri Jul 25 19:59:34 2008 UTC revision 53 by guez, Fri Oct 7 13:11:58 2011 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, presnivs, 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
12    
13      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! This is the main procedure for the "physics" part of the program.
14    
15      ! Objet: Moniteur general de la physique du modele      USE abort_gcm_m, ONLY: abort_gcm
16      !AA      Modifications quant aux traceurs :      use ajsec_m, only: ajsec
17      !AA                  -  uniformisation des parametrisations ds phytrac      USE calendar, ONLY: ymds2ju
18      !AA                  -  stockage des moyennes des champs necessaires      use calltherm_m, only: calltherm
19      !AA                     en mode traceur off-line      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
20             ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
21      USE ioipsl, only: ymds2ju, histwrite, histsync      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
22      use dimens_m, only: jjm, iim, llm           ok_orodr, ok_orolf, soil_model
23      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      USE clmain_m, ONLY: clmain
24           clnsurf, epsfra      USE comgeomphy, ONLY: airephy, cuphy, cvphy
25      use dimphy, only: klon, nbtr      USE concvl_m, ONLY: concvl
26      use conf_gcm_m, only: raz_date, offline, iphysiq      USE conf_gcm_m, ONLY: offline, raz_date
27      use dimsoil, only: nsoilmx      USE conf_phys_m, ONLY: conf_phys
28      use temps, only: itau_phy, day_ref, annee_ref, itaufin      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
29      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      use diagcld2_m, only: diagcld2
30           ecrit_ins, ecrit_mth, ecrit_day, &      use diagetpq_m, only: diagetpq
31           cdmmax, cdhmax, &      USE dimens_m, ONLY: iim, jjm, llm, nqmx
32           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &      USE dimphy, ONLY: klon, nbtr
33           ok_kzmin      USE dimsoil, ONLY: nsoilmx
34      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use drag_noro_m, only: drag_noro
35           cycle_diurne, new_oliq, soil_model      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
36      use iniprint, only: prt_level      USE hgardfou_m, ONLY: hgardfou
37      use abort_gcm_m, only: abort_gcm      USE histcom, ONLY: histsync
38      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE histwrite_m, ONLY: histwrite
39      use comgeomphy      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
40      use ctherm           nbsrf
41      use phytrac_m, only: phytrac      USE ini_histhf_m, ONLY: ini_histhf
42      use oasis_m      USE ini_histday_m, ONLY: ini_histday
43      use radepsi      USE ini_histins_m, ONLY: ini_histins
44      use radopt      USE oasis_m, ONLY: ok_oasis
45      use yoethf      USE orbite_m, ONLY: orbite, zenang
46      use ini_hist, only: ini_histhf, ini_histday, ini_histins      USE ozonecm_m, ONLY: ozonecm
47      use orbite_m, only: orbite, zenang      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
48      use phyetat0_m, only: phyetat0, rlat, rlon      USE phyredem_m, ONLY: phyredem
49      use hgardfou_m, only: hgardfou      USE phystokenc_m, ONLY: phystokenc
50      use conf_phys_m, only: conf_phys      USE phytrac_m, ONLY: phytrac
51        USE qcheck_m, ONLY: qcheck
52      ! Declaration des constantes et des fonctions thermodynamiques :      use radlwsw_m, only: radlwsw
53      use fcttre, only: thermcep, foeew, qsats, qsatl      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
54        USE temps, ONLY: annee_ref, day_ref, itau_phy
55      ! Variables argument:      USE yoethf_m, ONLY: r2es, rvtmp2
56    
57      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      ! Arguments:
58      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience  
59      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: rdayvrai
60      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      ! (elapsed time since January 1st 0h of the starting year, in days)
61      LOGICAL, intent(in):: firstcal ! first call to "calfis"  
62        REAL, intent(in):: time ! heure de la journée en fraction de jour
63        REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
64      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
65    
66      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm + 1)
67      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
68        
69      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: play(klon, llm)
70      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
71    
72      REAL pphi(klon, llm)        REAL, intent(in):: pphi(klon, llm)
73      ! (input geopotentiel de chaque couche (g z) (reference sol))      ! (input geopotentiel de chaque couche (g z) (reference sol))
74    
75      REAL pphis(klon) ! input geopotentiel du sol      REAL, intent(in):: pphis(klon) ! input geopotentiel du sol
76    
77      REAL presnivs(llm)      REAL, intent(in):: u(klon, llm)
78      ! (input pressions approximat. des milieux couches ( en PA))      ! vitesse dans la direction X (de O a E) en m/s
79    
80      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL, intent(in):: v(klon, llm) ! vitesse Y (de S a N) en m/s
81      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL, intent(in):: t(klon, llm) ! input temperature (K)
82      REAL t(klon, llm)  ! input temperature (K)  
83        REAL, intent(in):: qx(klon, llm, nqmx)
84      REAL, intent(in):: qx(klon, llm, nq)      ! (humidité spécifique et fractions massiques des autres traceurs)
85      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)  
86        REAL omega(klon, llm) ! input vitesse verticale en Pa/s
87      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL, intent(out):: d_u(klon, llm) ! tendance physique de "u" (m/s/s)
88      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL, intent(out):: d_v(klon, llm) ! tendance physique de "v" (m/s/s)
89      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL, intent(out):: d_t(klon, llm) ! tendance physique de "t" (K/s)
90      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_qx(klon, llm, nqmx) ! output tendance physique de "qx" (kg/kg/s)
91      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
92      REAL d_ps(klon)  ! output tendance physique de la pression au sol  
93        LOGICAL:: firstcal = .true.
94    
95      INTEGER nbteta      INTEGER nbteta
96      PARAMETER(nbteta=3)      PARAMETER(nbteta = 3)
97    
98      REAL PVteta(klon, nbteta)      REAL PVteta(klon, nbteta)
99      ! (output vorticite potentielle a des thetas constantes)      ! (output vorticite potentielle a des thetas constantes)
100    
101      LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE      LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
102      PARAMETER (ok_cvl=.TRUE.)      PARAMETER (ok_cvl = .TRUE.)
103      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
104      PARAMETER (ok_gust=.FALSE.)      PARAMETER (ok_gust = .FALSE.)
105    
106      LOGICAL check ! Verifier la conservation du modele en eau      LOGICAL check ! Verifier la conservation du modele en eau
107      PARAMETER (check=.FALSE.)      PARAMETER (check = .FALSE.)
108      LOGICAL ok_stratus ! Ajouter artificiellement les stratus  
109      PARAMETER (ok_stratus=.FALSE.)      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110        ! Ajouter artificiellement les stratus
111    
112      ! Parametres lies au coupleur OASIS:      ! Parametres lies au coupleur OASIS:
113      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE:: npas, nexca
114      logical rnpb      logical rnpb
115      parameter(rnpb=.true.)      parameter(rnpb = .true.)
116    
117      character(len=6), save:: ocean      character(len = 6), save:: ocean
118      ! (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")
119    
120      logical ok_ocean      logical ok_ocean
121      SAVE ok_ocean      SAVE ok_ocean
122    
123      !IM "slab" ocean      ! "slab" ocean
124      REAL tslab(klon)    !Temperature du slab-ocean      REAL, save:: tslab(klon) ! temperature of ocean slab
125      SAVE tslab      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
126      REAL seaice(klon)   !glace de mer (kg/m2)      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
127      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  
128    
129      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
130      logical ok_veget      logical, save:: ok_veget
131      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
132    
133      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
134    
# Line 141  contains Line 136  contains
136      save ok_instan      save ok_instan
137    
138      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
139      PARAMETER (ok_region=.FALSE.)      PARAMETER (ok_region = .FALSE.)
140    
141      !     pour phsystoke avec thermiques      ! pour phsystoke avec thermiques
142      REAL fm_therm(klon, llm+1)      REAL fm_therm(klon, llm + 1)
143      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
144      real q2(klon, llm+1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
145      save q2  
146        INTEGER ivap ! indice de traceurs pour vapeur d'eau
147        PARAMETER (ivap = 1)
148        INTEGER iliq ! indice de traceurs pour eau liquide
149        PARAMETER (iliq = 2)
150    
151      INTEGER ivap          ! indice de traceurs pour vapeur d'eau      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
152      PARAMETER (ivap=1)      LOGICAL, save:: ancien_ok
     INTEGER iliq          ! indice de traceurs pour eau liquide  
     PARAMETER (iliq=2)  
   
     REAL t_ancien(klon, llm), q_ancien(klon, llm)  
     SAVE t_ancien, q_ancien  
     LOGICAL ancien_ok  
     SAVE ancien_ok  
153    
154      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)
155      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)
156    
157      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
158    
159      !IM Amip2 PV a theta constante      !IM Amip2 PV a theta constante
160    
161      CHARACTER(LEN=3) ctetaSTD(nbteta)      CHARACTER(LEN = 3) ctetaSTD(nbteta)
162      DATA ctetaSTD/'350', '380', '405'/      DATA ctetaSTD/'350', '380', '405'/
163      REAL rtetaSTD(nbteta)      REAL rtetaSTD(nbteta)
164      DATA rtetaSTD/350., 380., 405./      DATA rtetaSTD/350., 380., 405./
# Line 174  contains Line 166  contains
166      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
167    
168      INTEGER klevp1      INTEGER klevp1
169      PARAMETER(klevp1=llm+1)      PARAMETER(klevp1 = llm + 1)
170    
171      REAL swdn0(klon, klevp1), swdn(klon, klevp1)      REAL swdn0(klon, klevp1), swdn(klon, klevp1)
172      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
173      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
174    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
175      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
176      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
177      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
178    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
179      !IM Amip2      !IM Amip2
180      ! variables a une pression donnee      ! variables a une pression donnee
181    
182      integer nlevSTD      integer nlevSTD
183      PARAMETER(nlevSTD=17)      PARAMETER(nlevSTD = 17)
184      real rlevSTD(nlevSTD)      real rlevSTD(nlevSTD)
185      DATA rlevSTD/100000., 92500., 85000., 70000., &      DATA rlevSTD/100000., 92500., 85000., 70000., &
186           60000., 50000., 40000., 30000., 25000., 20000., &           60000., 50000., 40000., 30000., 25000., 20000., &
187           15000., 10000., 7000., 5000., 3000., 2000., 1000./           15000., 10000., 7000., 5000., 3000., 2000., 1000./
188      CHARACTER(LEN=4) clevSTD(nlevSTD)      CHARACTER(LEN = 4) clevSTD(nlevSTD)
189      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &      DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &
190           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
191           '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  
   
     REAL tsumSTD(klon, nlevSTD, nout)  
     REAL usumSTD(klon, nlevSTD, nout), vsumSTD(klon, nlevSTD, nout)  
     REAL wsumSTD(klon, nlevSTD, nout), phisumSTD(klon, nlevSTD, nout)  
     REAL qsumSTD(klon, nlevSTD, nout), rhsumSTD(klon, nlevSTD, nout)  
   
     SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,  &  
          qsumSTD, rhsumSTD  
   
     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 uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
     real vphisumSTD(klon, nlevSTD, nout)  
     real wTsumSTD(klon, nlevSTD, nout)  
     real u2sumSTD(klon, nlevSTD, nout)  
     real v2sumSTD(klon, nlevSTD, nout)  
     real T2sumSTD(klon, nlevSTD, nout)  
   
     SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD  
     SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD  
     !MI Amip2  
192    
193      ! prw: precipitable water      ! prw: precipitable water
194      real prw(klon)      real prw(klon)
# Line 265  contains Line 198  contains
198      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
199      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
200    
201      INTEGER l, kmax, lmax      INTEGER kmax, lmax
202      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax = 8, lmax = 8)
203      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
204      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
205    
206      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
207      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 279  contains Line 212  contains
212      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./      DATA cldtopres/50., 180., 310., 440., 560., 680., 800./
213    
214      ! taulev: numero du niveau de tau dans les sorties ISCCP      ! taulev: numero du niveau de tau dans les sorties ISCCP
215      CHARACTER(LEN=4) taulev(kmaxm1)      CHARACTER(LEN = 4) taulev(kmaxm1)
216    
217      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/      DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/
218      CHARACTER(LEN=3) pclev(lmaxm1)      CHARACTER(LEN = 3) pclev(lmaxm1)
219      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/      DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/
220    
221      CHARACTER(LEN=28) cnameisccp(lmaxm1, kmaxm1)      CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)
222      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', &
223           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &           'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &
224           '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 317  contains Line 250  contains
250      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
251      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
252    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
253      ! Variables propres a la physique      ! Variables propres a la physique
254    
255      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 327  contains Line 257  contains
257      ! "physiq".)      ! "physiq".)
258    
259      REAL radsol(klon)      REAL radsol(klon)
260      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
261    
262      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
263    
264      REAL ftsol(klon, nbsrf)      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
     SAVE ftsol                  ! temperature du sol  
265    
266      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
267      SAVE ftsoil                 ! temperature dans le sol      ! soil temperature of surface fraction
268    
269      REAL fevap(klon, nbsrf)      REAL fevap(klon, nbsrf)
270      SAVE fevap                 ! evaporation      SAVE fevap ! evaporation
271      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
272      SAVE fluxlat      SAVE fluxlat
273    
274      REAL fqsurf(klon, nbsrf)      REAL fqsurf(klon, nbsrf)
275      SAVE fqsurf                 ! humidite de l'air au contact de la surface      SAVE fqsurf ! humidite de l'air au contact de la surface
276    
277      REAL qsol(klon)      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol
     SAVE qsol                  ! hauteur d'eau dans le sol  
278    
279      REAL fsnow(klon, nbsrf)      REAL fsnow(klon, nbsrf)
280      SAVE fsnow                  ! epaisseur neigeuse      SAVE fsnow ! epaisseur neigeuse
281    
282      REAL falbe(klon, nbsrf)      REAL falbe(klon, nbsrf)
283      SAVE falbe                  ! albedo par type de surface      SAVE falbe ! albedo par type de surface
284      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
285      SAVE falblw                 ! albedo par type de surface      SAVE falblw ! albedo par type de surface
286    
287      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
288      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 371  contains Line 299  contains
299      INTEGER igwd, idx(klon), itest(klon)      INTEGER igwd, idx(klon), itest(klon)
300    
301      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
302      SAVE agesno                 ! age de la neige      SAVE agesno ! age de la neige
303    
304      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
305      SAVE run_off_lic_0      SAVE run_off_lic_0
306      !KE43      !KE43
307      ! Variables liees a la convection de K. Emanuel (sb):      ! Variables liees a la convection de K. Emanuel (sb):
308    
309      REAL bas, top             ! cloud base and top levels      REAL bas, top ! cloud base and top levels
310      SAVE bas      SAVE bas
311      SAVE top      SAVE top
312    
313      REAL Ma(klon, llm)        ! undilute upward mass flux      REAL Ma(klon, llm) ! undilute upward mass flux
314      SAVE Ma      SAVE Ma
315      REAL qcondc(klon, llm)    ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
316      SAVE qcondc      SAVE qcondc
317      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
318      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
319    
320      REAL wd(klon) ! sb      REAL wd(klon) ! sb
321      SAVE wd       ! sb      SAVE wd ! sb
322    
323      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
324    
# Line 399  contains Line 327  contains
327      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
328      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
329    
330      !AA  Pour phytrac      !AA Pour phytrac
331      REAL ycoefh(klon, llm)    ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
332      REAL yu1(klon)            ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
333      REAL yv1(klon)            ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
334      REAL ffonte(klon, nbsrf)    !Flux thermique utilise pour fondre la neige      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige
335      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface
336      !                               !et necessaire pour limiter la      ! !et necessaire pour limiter la
337      !                               !hauteur de neige, en kg/m2/s      ! !hauteur de neige, en kg/m2/s
338      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
339    
340      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
# Line 425  contains Line 353  contains
353      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
354      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
355    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
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 453  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) ! ozone      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 ozonecm   ! prescrire l'ozone      EXTERNAL transp ! transport total de l'eau et de l'energie
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
     EXTERNAL radlwsw   ! rayonnements solaire et infrarouge  
     EXTERNAL transp    ! transport total de l'eau et de l'energie  
   
     EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression  
   
     EXTERNAL undefSTD  
     ! (somme les valeurs definies d'1 var a 1 niveau de pression)  
397    
398      ! Variables locales      ! Variables locales
399    
# Line 487  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 calcule tous les pas, il faut donc
424      REAL heat0(klon, llm)   ! chauffage solaire ciel clair      ! que 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 cool(klon, llm) ! refroidissement infrarouge
428        REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
429      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
430      real sollwdown(klon)    ! downward LW flux at surface      real sollwdown(klon) ! downward LW flux at surface
431      REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL 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 cool, albpla, topsw, toplw, solsw, sollw, sollwdown
436      !                      sauvegarder les sorties du rayonnement      SAVE topsw0, toplw0, solsw0, sollw0, 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 539  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)
# Line 567  contains Line 482  contains
482    
483      ! Variables locales pour la convection de K. Emanuel (sb):      ! Variables locales pour la convection de K. Emanuel (sb):
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 603  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)
523    
524      INTEGER ibas_con(klon), itop_con(klon)      INTEGER,save:: ibas_con(klon), itop_con(klon)
   
     SAVE ibas_con, itop_con  
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 627  contains Line 540  contains
540      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
541    
542      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
543      real fact_cldcon      real, save:: fact_cldcon
544      real facttemps      real, save:: facttemps
545      logical ok_newmicro      logical ok_newmicro
546      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
547      real facteur      real facteur
548    
549      integer iflag_cldcon      integer iflag_cldcon
# Line 639  contains Line 551  contains
551    
552      logical ptconv(klon, llm)      logical ptconv(klon, llm)
553    
554      ! Variables liees a l'ecriture de la bande histoire physique      ! Variables locales pour effectuer les appels en série :
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
     ! Variables locales pour effectuer les appels en serie  
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 653  contains Line 561  contains
561      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
562    
563      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
564    
565      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
566      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
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 nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
576    
577      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
578      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 677  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) ztit
596      CHARACTER(LEN=15) ztit      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
597      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
598      SAVE      ip_ebil  
599      DATA      ip_ebil/0/      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
     INTEGER   if_ebil ! level for energy conserv. dignostics  
     SAVE      if_ebil  
     !+jld ec_conser  
     REAL d_t_ec(klon, llm)    ! tendance du a la conersion 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 ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
634      REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
635    
636      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1
637      SAVE u10m      SAVE u10m
# Line 755  contains Line 653  contains
653      SAVE d_v_con      SAVE d_v_con
654      SAVE rnebcon0      SAVE rnebcon0
655      SAVE clwcon0      SAVE clwcon0
656      SAVE pblh  
657      SAVE plcl      real zmasse(klon, llm)
658      SAVE capCL      ! (column-density of mass of air in a cell, in kg m-2)
659      SAVE oliqCL  
660      SAVE cteiCL      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     SAVE pblt  
     SAVE therm  
     SAVE trmb1  
     SAVE trmb2  
     SAVE trmb3  
661    
662      !----------------------------------------------------------------      !----------------------------------------------------------------
663    
664      modname = 'physiq'      modname = 'physiq'
665      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
666         DO i=1, klon         DO i = 1, klon
667            zero_v(i)=0.            zero_v(i) = 0.
668         END DO         END DO
669      END IF      END IF
670      ok_sync=.TRUE.      ok_sync = .TRUE.
671      IF (nq  <  2) THEN      IF (nqmx < 2) THEN
672         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
673         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
674      ENDIF      ENDIF
675    
676      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
677         !  initialiser         ! initialiser
678         u10m=0.         u10m = 0.
679         v10m=0.         v10m = 0.
680         t2m=0.         t2m = 0.
681         q2m=0.         q2m = 0.
682         ffonte=0.         ffonte = 0.
683         fqcalving=0.         fqcalving = 0.
684         piz_ae(:, :, :)=0.         piz_ae = 0.
685         tau_ae(:, :, :)=0.         tau_ae = 0.
686         cg_ae(:, :, :)=0.         cg_ae = 0.
687         rain_con(:)=0.         rain_con(:) = 0.
688         snow_con(:)=0.         snow_con(:) = 0.
689         bl95_b0=0.         bl95_b0 = 0.
690         bl95_b1=0.         bl95_b1 = 0.
691         topswai(:)=0.         topswai(:) = 0.
692         topswad(:)=0.         topswad(:) = 0.
693         solswai(:)=0.         solswai(:) = 0.
694         solswad(:)=0.         solswad(:) = 0.
695    
696         d_u_con = 0.0         d_u_con = 0.0
697         d_v_con = 0.0         d_v_con = 0.0
# Line 807  contains Line 700  contains
700         rnebcon = 0.0         rnebcon = 0.0
701         clwcon = 0.0         clwcon = 0.0
702    
703         pblh   =0.        ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
704         plcl   =0.        ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
705         capCL  =0.        ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
706         oliqCL =0.        ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
707         cteiCL =0.        ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
708         pblt   =0.        ! T a la Hauteur de couche limite         pblt =0. ! T a la Hauteur de couche limite
709         therm  =0.         therm =0.
710         trmb1  =0.        ! deep_cape         trmb1 =0. ! deep_cape
711         trmb2  =0.        ! inhibition         trmb2 =0. ! inhibition
712         trmb3  =0.        ! Point Omega         trmb3 =0. ! Point Omega
713    
714         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
715    
716         ! appel a la lecture du run.def physique         ! appel a la lecture du run.def physique
717    
718         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, &
719              ok_instan, fact_cldcon, facttemps, ok_newmicro, &              ok_instan, fact_cldcon, facttemps, ok_newmicro, &
720              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &              iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
721              ok_ade, ok_aie,  &              ok_ade, ok_aie, &
722              bl95_b0, bl95_b1, &              bl95_b0, bl95_b1, &
723              iflag_thermals, nsplit_thermals)              iflag_thermals, nsplit_thermals)
724    
# Line 835  contains Line 728  contains
728         itap = 0         itap = 0
729         itaprad = 0         itaprad = 0
730         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
731              seaice, fqsurf, qsol, fsnow, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
732              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &
733              dlw, radsol, frugs, agesno, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
734              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)  
735    
736         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
737         q2(:, :, :)=1.e-8         q2 = 1.e-8
738    
739         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
740    
741         ! on remet le calendrier a zero         ! on remet le calendrier a zero
742           IF (raz_date) itau_phy = 0
        IF (raz_date == 1) THEN  
           itau_phy = 0  
        ENDIF  
743    
744         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
745    
746         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
747            ok_ocean=.TRUE.            ok_ocean = .TRUE.
748         ENDIF         ENDIF
749    
750         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
751              ok_region)              ok_region)
752    
753         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN
754            print *,'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
755            print *,"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
756            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message = 'Nbre d appels au rayonnement insuffisant'
757            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
758         ENDIF         ENDIF
759         print *,"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con = ", iflag_con
760         print *,"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl = ", &
761              ok_cvl              ok_cvl
762    
763         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
764         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
765    
766            print *,"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3 "
767    
768            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
769            DO i = 1, klon            DO i = 1, klon
# Line 888  contains Line 776  contains
776    
777         IF (ok_orodr) THEN         IF (ok_orodr) THEN
778            rugoro = MAX(1e-5, zstd * zsig / 2)            rugoro = MAX(1e-5, zstd * zsig / 2)
779            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, play)
780         else         else
781            rugoro = 0.            rugoro = 0.
782         ENDIF         ENDIF
783    
784         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours         lmt_pas = NINT(86400. / dtphys) ! tous les jours
785         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
786    
787         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
788         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
789         ecrit_day = NINT(ecrit_day/pdtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
790         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/dtphys)
791         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_reg = NINT(ecrit_reg/dtphys)
        ecrit_reg = NINT(ecrit_reg/pdtphys)  
792    
793         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
794    
795         npas = 0         npas = 0
796         nexca = 0         nexca = 0
797    
798         print *,'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON = ', iflag_con
799    
800         !   Initialisation des sorties         ! Initialisation des sorties
801    
802         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(dtphys, nid_hf, nid_hf3d)
803         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
804         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
805         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
806         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
807         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0: ', date0
808      ENDIF test_firstcal      ENDIF test_firstcal
809    
810      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
# Line 925  contains Line 812  contains
812      DO i = 1, klon      DO i = 1, klon
813         d_ps(i) = 0.0         d_ps(i) = 0.0
814      ENDDO      ENDDO
815      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  
816         DO k = 1, llm         DO k = 1, llm
817            DO i = 1, klon            DO i = 1, klon
818               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
819            ENDDO            ENDDO
820         ENDDO         ENDDO
821      ENDDO      ENDDO
822      da=0.      da = 0.
823      mp=0.      mp = 0.
824      phi(:, :, :)=0.      phi = 0.
825    
826      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrées de u, v, h, et q :
827    
828      DO k = 1, llm      DO k = 1, llm
829         DO i = 1, klon         DO i = 1, klon
830            t_seri(i, k)  = t(i, k)            t_seri(i, k) = t(i, k)
831            u_seri(i, k)  = u(i, k)            u_seri(i, k) = u(i, k)
832            v_seri(i, k)  = v(i, k)            v_seri(i, k) = v(i, k)
833            q_seri(i, k)  = qx(i, k, ivap)            q_seri(i, k) = qx(i, k, ivap)
834            ql_seri(i, k) = qx(i, k, iliq)            ql_seri(i, k) = qx(i, k, iliq)
835            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
836         ENDDO         ENDDO
837      ENDDO      ENDDO
838      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
839         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
840      ELSE      ELSE
841         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
842      ENDIF      ENDIF
# Line 971  contains Line 851  contains
851      ENDDO      ENDDO
852    
853      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
854         ztit='after dynamic'         ztit = 'after dynamics'
855         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
856              , 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, &
857              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
858         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoutés dans la
859         !     on devrait avoir que la variation d'entalpie par la dynamique         !  dynamique, la variation d'enthalpie par la dynamique devrait
860         !     est egale a la variation de la physique au pas de temps precedent.         !  être égale à la variation de la physique au pas de temps
861         !     Donc la somme de ces 2 variations devrait etre nulle.         !  précédent.  Donc la somme de ces 2 variations devrait être
862         call diagphy(airephy, ztit, ip_ebil &         !  nulle.
863              , zero_v, zero_v, zero_v, zero_v, zero_v &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
864              , zero_v, zero_v, zero_v, ztsol &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &
865              , d_h_vcol+d_h_vcol_phy, d_qt, 0. &              d_qt, 0., fs_bound, fq_bound)
             , fs_bound, fq_bound )  
866      END IF      END IF
867    
868      ! Diagnostiquer la tendance dynamique      ! Diagnostic de la tendance dynamique :
   
869      IF (ancien_ok) THEN      IF (ancien_ok) THEN
870         DO k = 1, llm         DO k = 1, llm
871            DO i = 1, klon            DO i = 1, klon
872               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
873               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
874            ENDDO            ENDDO
875         ENDDO         ENDDO
876      ELSE      ELSE
# Line 1006  contains Line 884  contains
884      ENDIF      ENDIF
885    
886      ! Ajouter le geopotentiel du sol:      ! Ajouter le geopotentiel du sol:
   
887      DO k = 1, llm      DO k = 1, llm
888         DO i = 1, klon         DO i = 1, klon
889            zphi(i, k) = pphi(i, k) + pphis(i)            zphi(i, k) = pphi(i, k) + pphis(i)
890         ENDDO         ENDDO
891      ENDDO      ENDDO
892    
893      ! Verifier les temperatures      ! Check temperatures:
   
894      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
895    
896      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
   
897      itap = itap + 1      itap = itap + 1
898      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
899      if (julien == 0) julien = 360      if (julien == 0) julien = 360
900    
901        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
902    
903      ! 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.  
904    
905      IF (MOD(itap - 1, lmt_pas) == 0) THEN      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
906         CALL ozonecm(REAL(julien), rlat, paprs, wo)      if (nqmx >= 5) then
907           wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
908        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
909           wo = ozonecm(REAL(julien), paprs)
910      ENDIF      ENDIF
911    
912      ! Re-evaporer l'eau liquide nuageuse      ! Évaporation de l'eau liquide nuageuse :
913        DO k = 1, llm
     DO k = 1, llm  ! re-evaporation de l'eau liquide nuageuse  
914         DO i = 1, klon         DO i = 1, klon
915            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            zb = MAX(0., ql_seri(i, k))
916            zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i, k))            t_seri(i, k) = t_seri(i, k) &
917            zdelta = MAX(0., SIGN(1., RTT-t_seri(i, k)))                 - zb * RLVTT / RCPD / (1. + RVTMP2 * q_seri(i, k))
           zb = MAX(0.0, ql_seri(i, k))  
           za = - MAX(0.0, ql_seri(i, k)) &  
                * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)  
           t_seri(i, k) = t_seri(i, k) + za  
918            q_seri(i, k) = q_seri(i, k) + zb            q_seri(i, k) = q_seri(i, k) + zb
           ql_seri(i, k) = 0.0  
919         ENDDO         ENDDO
920      ENDDO      ENDDO
921        ql_seri = 0.
922    
923      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
924         ztit='after reevap'         ztit = 'after reevap'
925         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &
926              , 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, &
927              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
928         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
929              , 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, &
930              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
931    
932      END IF      END IF
933    
# Line 1079  contains Line 951  contains
951    
952      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
953      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
954         zdtime = pdtphys * REAL(radpas)         zdtime = dtphys * REAL(radpas)
955         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, time, zdtime, rmu0, fract)
956      ELSE      ELSE
957         rmu0 = -999.999         rmu0 = -999.999
958      ENDIF      ENDIF
959    
960      !     Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
961      albsol(:)=0.      albsol(:) = 0.
962      albsollw(:)=0.      albsollw(:) = 0.
963      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
964         DO i = 1, klon         DO i = 1, klon
965            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)            albsol(i) = albsol(i) + falbe(i, nsrf) * pctsrf(i, nsrf)
# Line 1095  contains Line 967  contains
967         ENDDO         ENDDO
968      ENDDO      ENDDO
969    
970      !     Repartition sous maille des flux LW et SW      ! Repartition sous maille des flux LW et SW
971      ! Repartition du longwave par sous-surface linearisee      ! Repartition du longwave par sous-surface linearisee
972    
973      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
# Line 1108  contains Line 980  contains
980    
981      fder = dlw      fder = dlw
982    
983      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &      ! Couche limite:
984           t_seri, q_seri, u_seri, v_seri, &  
985           julien, rmu0, co2_ppm,  &      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &
986           ok_veget, ocean, npas, nexca, ftsol, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &
987           soil_model, cdmmax, cdhmax, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
988           ksta, ksta_ter, ok_kzmin, ftsoil, qsol,  &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
989           paprs, pplay, fsnow, fqsurf, fevap, falbe, falblw, &           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &
990           fluxlat, rain_fall, snow_fall, &           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &
991           fsolsw, fsollw, sollwdown, fder, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
992           rlon, rlat, cuphy, cvphy, frugs, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
993           firstcal, lafin, agesno, rugoro, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
994           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, seaice)
995           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
996           q2, dsens, devap, &      ! Incrémentation des flux
997           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &  
998           pblh, capCL, oliqCL, cteiCL, pblT, &      zxfluxt = 0.
999           therm, trmb1, trmb2, trmb3, plcl, &      zxfluxq = 0.
1000           fqcalving, ffonte, run_off_lic_0, &      zxfluxu = 0.
1001           fluxo, fluxg, tslab, seaice)      zxfluxv = 0.
   
     !XXX Incrementation des flux  
   
     zxfluxt=0.  
     zxfluxq=0.  
     zxfluxu=0.  
     zxfluxv=0.  
1002      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1003         DO k = 1, llm         DO k = 1, llm
1004            DO i = 1, klon            DO i = 1, klon
1005               zxfluxt(i, k) = zxfluxt(i, k) +  &               zxfluxt(i, k) = zxfluxt(i, k) + &
1006                    fluxt(i, k, nsrf) * pctsrf( i, nsrf)                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)
1007               zxfluxq(i, k) = zxfluxq(i, k) +  &               zxfluxq(i, k) = zxfluxq(i, k) + &
1008                    fluxq(i, k, nsrf) * pctsrf( i, nsrf)                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)
1009               zxfluxu(i, k) = zxfluxu(i, k) +  &               zxfluxu(i, k) = zxfluxu(i, k) + &
1010                    fluxu(i, k, nsrf) * pctsrf( i, nsrf)                    fluxu(i, k, nsrf) * pctsrf(i, nsrf)
1011               zxfluxv(i, k) = zxfluxv(i, k) +  &               zxfluxv(i, k) = zxfluxv(i, k) + &
1012                    fluxv(i, k, nsrf) * pctsrf( i, nsrf)                    fluxv(i, k, nsrf) * pctsrf(i, nsrf)
1013            END DO            END DO
1014         END DO         END DO
1015      END DO      END DO
# Line 1164  contains Line 1029  contains
1029      ENDDO      ENDDO
1030    
1031      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1032         ztit='after clmain'         ztit = 'after clmain'
1033         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1034              , 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, &
1035              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1036         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1037              , zero_v, zero_v, zero_v, zero_v, sens &              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1038              , evap, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1039      END IF      END IF
1040    
1041      ! Incrementer la temperature du sol      ! Update surface temperature:
1042    
1043      DO i = 1, klon      DO i = 1, klon
1044         zxtsol(i) = 0.0         zxtsol(i) = 0.0
# Line 1199  contains Line 1062  contains
1062         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1063         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1064    
1065         IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +  &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &
1066              pctsrf(i, is_oce) + pctsrf(i, is_sic)  - 1.) .GT. EPSFRA)  &              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &
1067              THEN              THEN
1068            WRITE(*, *) 'physiq : pb sous surface au point ', i,  &            WRITE(*, *) 'physiq : pb sous surface au point ', i, &
1069                 pctsrf(i, 1 : nbsrf)                 pctsrf(i, 1 : nbsrf)
1070         ENDIF         ENDIF
1071      ENDDO      ENDDO
# Line 1217  contains Line 1080  contains
1080            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)
1081            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)
1082            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)
1083            zxfqcalving(i) = zxfqcalving(i) +  &            zxfqcalving(i) = zxfqcalving(i) + &
1084                 fqcalving(i, nsrf)*pctsrf(i, nsrf)                 fqcalving(i, nsrf)*pctsrf(i, nsrf)
1085            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)
1086            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 1236  contains Line 1099  contains
1099    
1100      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1101         DO i = 1, klon         DO i = 1, klon
1102            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)
1103    
1104            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)
1105            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)
1106            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)
1107            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)
1108            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)
1109            IF (pctsrf(i, nsrf)  <  epsfra)  &            IF (pctsrf(i, nsrf) < epsfra) &
1110                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1111            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)
1112            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)
1113            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)
1114            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)
1115            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)
1116            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)
1117            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)
1118            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)
1119            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)
1120            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)
1121         ENDDO         ENDDO
1122      ENDDO      ENDDO
1123    
# Line 1268  contains Line 1131  contains
1131    
1132      DO k = 1, llm      DO k = 1, llm
1133         DO i = 1, klon         DO i = 1, klon
1134            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k) &
1135                 + d_q_vdf(i, k)/pdtphys                 + d_q_vdf(i, k)/dtphys
1136            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k) &
1137                 + d_t_vdf(i, k)/pdtphys                 + d_t_vdf(i, k)/dtphys
1138         ENDDO         ENDDO
1139      ENDDO      ENDDO
1140      IF (check) THEN      IF (check) THEN
1141         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1142         print *, "avantcon=", za         print *, "avantcon = ", za
1143      ENDIF      ENDIF
1144      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1145      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq = .TRUE.
1146      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1147         DO i = 1, klon         DO i = 1, klon
1148            z_avant(i) = 0.0            z_avant(i) = 0.0
1149         ENDDO         ENDDO
1150         DO k = 1, llm         DO k = 1, llm
1151            DO i = 1, klon            DO i = 1, klon
1152               z_avant(i) = z_avant(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &
1153                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1154            ENDDO            ENDDO
1155         ENDDO         ENDDO
1156      ENDIF      ENDIF
1157      IF (iflag_con == 1) THEN  
1158         stop 'reactiver le call conlmd dans physiq.F'      select case (iflag_con)
1159      ELSE IF (iflag_con == 2) THEN      case (1)
1160         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &         print *, 'Réactiver l''appel à "conlmd" dans "physiq.F".'
1161              conv_t, conv_q, zxfluxq(1, 1), omega, &         stop 1
1162              d_t_con, d_q_con, rain_con, snow_con, &      case (2)
1163              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1164              kcbot, kctop, kdtop, pmflxr, pmflxs)              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1165                pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
1166                pmflxs)
1167         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1168         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1169         DO i = 1, klon         DO i = 1, klon
1170            ibas_con(i) = llm+1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1171            itop_con(i) = llm+1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1172         ENDDO         ENDDO
1173      ELSE IF (iflag_con >= 3) THEN      case (3:)
1174         ! nb of tracers for the KE convection:         ! number of tracers for the convection scheme of Kerry Emanuel:
1175         ! MAF la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1176         ! on met ntra=1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1177         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.
1178         ntra = 1         ntra = 1
1179         ! Schema de convection modularise et vectorise:         ! Schéma de convection modularisé et vectorisé :
1180         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1181    
1182         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN
1183            CALL concvl (iflag_con, &            ! new driver for convectL
1184                 pdtphys, paprs, pplay, t_seri, q_seri, &            CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, &
1185                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, &
1186                 ema_work1, ema_work2, &                 d_q_con, d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1187                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, &
1188                 rain_con, snow_con, ibas_con, itop_con, &                 bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, &
1189                 upwd, dnwd, dnwd0, &                 pmflxs, da, phi, mp)
1190                 Ma, cape, tvp, iflagctrl, &            clwcon0 = qcondc
1191                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, &            pmfu = upwd + dnwd
1192                 pmflxr, pmflxs, &         ELSE
1193                 da, phi, mp)            ! conema3 ne contient pas les traceurs
1194              CALL conema3(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, &
1195            clwcon0=qcondc                 tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &
1196            pmfu=upwd+dnwd                 d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1197         ELSE ! ok_cvl                 itop_con, upwd, dnwd, dnwd0, bas, top, Ma, cape, tvp, rflag, &
1198            ! MAF conema3 ne contient pas les traceurs                 pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, clwcon0)
1199            CALL conema3 (pdtphys, &         ENDIF
                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  
1200    
1201         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
1202            do i = 1, klon            do i = 1, klon
1203               wd(i)=0.0               wd(i) = 0.0
1204            enddo            enddo
1205         ENDIF         ENDIF
1206    
1207         ! Calcul des proprietes des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1208    
1209         DO k = 1, llm         DO k = 1, llm
1210            DO i = 1, klon            DO i = 1, klon
1211               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1212               IF (thermcep) THEN               IF (thermcep) THEN
1213                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1214                  zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1215                  zx_qs  = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1216                  zcor   = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1217                  zx_qs  = zx_qs*zcor                  zx_qs = zx_qs*zcor
1218               ELSE               ELSE
1219                  IF (zx_t < t_coup) THEN                  IF (zx_t < t_coup) THEN
1220                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/play(i, k)
1221                  ELSE                  ELSE
1222                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/play(i, k)
1223                  ENDIF                  ENDIF
1224               ENDIF               ENDIF
1225               zqsat(i, k)=zx_qs               zqsat(i, k) = zx_qs
1226            ENDDO            ENDDO
1227         ENDDO         ENDDO
1228    
1229         !   calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1230         clwcon0=fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1231         call clouds_gno &         call clouds_gno &
1232              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1233      ELSE      case default
1234         print *, "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1235         stop 1         stop 1
1236      ENDIF      END select
1237    
1238      DO k = 1, llm      DO k = 1, llm
1239         DO i = 1, klon         DO i = 1, klon
# Line 1391  contains Line 1245  contains
1245      ENDDO      ENDDO
1246    
1247      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1248         ztit='after convect'         ztit = 'after convect'
1249         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1250              , 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, &
1251              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1252         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1253              , 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, &
1254              , zero_v, rain_con, snow_con, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1255      END IF      END IF
1256    
1257      IF (check) THEN      IF (check) THEN
1258         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1259         print *,"aprescon=", za         print *,"aprescon = ", za
1260         zx_t = 0.0         zx_t = 0.0
1261         za = 0.0         za = 0.0
1262         DO i = 1, klon         DO i = 1, klon
# Line 1412  contains Line 1264  contains
1264            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1265                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1266         ENDDO         ENDDO
1267         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1268         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1269      ENDIF      ENDIF
1270      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1271         DO i = 1, klon         DO i = 1, klon
# Line 1421  contains Line 1273  contains
1273         ENDDO         ENDDO
1274         DO k = 1, llm         DO k = 1, llm
1275            DO i = 1, klon            DO i = 1, klon
1276               z_apres(i) = z_apres(i) + (q_seri(i, k)+ql_seri(i, k)) &               z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &
1277                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1278            ENDDO            ENDDO
1279         ENDDO         ENDDO
1280         DO i = 1, klon         DO i = 1, klon
1281            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &            z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &
1282                 /z_apres(i)                 /z_apres(i)
1283         ENDDO         ENDDO
1284         DO k = 1, llm         DO k = 1, llm
1285            DO i = 1, klon            DO i = 1, klon
1286               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
                   z_factor(i) < (1.0-1.0E-08)) THEN  
1287                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1288               ENDIF               ENDIF
1289            ENDDO            ENDDO
1290         ENDDO         ENDDO
1291      ENDIF      ENDIF
1292      zx_ajustq=.FALSE.      zx_ajustq = .FALSE.
1293    
1294      ! Convection seche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1295    
1296      d_t_ajs=0.      d_t_ajs = 0.
1297      d_u_ajs=0.      d_u_ajs = 0.
1298      d_v_ajs=0.      d_v_ajs = 0.
1299      d_q_ajs=0.      d_q_ajs = 0.
1300      fm_therm=0.      fm_therm = 0.
1301      entr_therm=0.      entr_therm = 0.
1302    
1303      IF(prt_level>9)print *, &      if (iflag_thermals == 0) then
1304           'AVANT LA CONVECTION SECHE, iflag_thermals=' &         ! Ajustement sec
1305           , 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)  
1306         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
1307         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
1308      else      else
1309         !  Thermiques         ! Thermiques
1310         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &         call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &
1311              , 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)  
1312      endif      endif
1313    
1314      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1315         ztit='after dry_adjust'         ztit = 'after dry_adjust'
1316         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1317              , 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, &
1318              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1319      END IF      END IF
1320    
1321      !  Caclul des ratqs      ! Caclul des ratqs
1322    
1323      !   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q
1324      !   on ecrase le tableau ratqsc calcule par clouds_gno      ! on ecrase le tableau ratqsc calcule par clouds_gno
1325      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1326         do k=1, llm         do k = 1, llm
1327            do i=1, klon            do i = 1, klon
1328               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1329                  ratqsc(i, k)=ratqsbas &                  ratqsc(i, k) = ratqsbas &
1330                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)
1331               else               else
1332                  ratqsc(i, k)=0.                  ratqsc(i, k) = 0.
1333               endif               endif
1334            enddo            enddo
1335         enddo         enddo
1336      endif      endif
1337    
1338      !   ratqs stables      ! ratqs stables
1339      do k=1, llm      do k = 1, llm
1340         do i=1, klon         do i = 1, klon
1341            ratqss(i, k)=ratqsbas+(ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &
1342                 min((paprs(i, 1)-pplay(i, k))/(paprs(i, 1)-30000.), 1.)                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)
1343         enddo         enddo
1344      enddo      enddo
1345    
1346      !  ratqs final      ! ratqs final
1347      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then
1348         !   les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1349         !   ratqs final         ! ratqs final
1350         !   1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1351         !   relaxation des ratqs         ! relaxation des ratqs
1352         facteur=exp(-pdtphys*facttemps)         facteur = exp(-dtphys*facttemps)
1353         ratqs=max(ratqs*facteur, ratqss)         ratqs = max(ratqs*facteur, ratqss)
1354         ratqs=max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1355      else      else
1356         !   on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1357         ratqs=ratqss         ratqs = ratqss
1358      endif      endif
1359    
1360      ! Appeler le processus de condensation a grande echelle      ! Processus de condensation à grande echelle et processus de
1361      ! et le processus de precipitation      ! précipitation :
1362      CALL fisrtilp(pdtphys, paprs, pplay, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1363           t_seri, q_seri, ptconv, ratqs, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1364           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
1365           rain_lsc, snow_lsc, &           psfl, rhcl)
          pfrac_impa, pfrac_nucl, pfrac_1nucl, &  
          frac_impa, frac_nucl, &  
          prfl, psfl, rhcl)  
1366    
1367      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
1368      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1541  contains Line 1377  contains
1377      ENDDO      ENDDO
1378      IF (check) THEN      IF (check) THEN
1379         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1380         print *,"apresilp=", za         print *,"apresilp = ", za
1381         zx_t = 0.0         zx_t = 0.0
1382         za = 0.0         za = 0.0
1383         DO i = 1, klon         DO i = 1, klon
# Line 1549  contains Line 1385  contains
1385            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1386                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1387         ENDDO         ENDDO
1388         zx_t = zx_t/za*pdtphys         zx_t = zx_t/za*dtphys
1389         print *,"Precip=", zx_t         print *,"Precip = ", zx_t
1390      ENDIF      ENDIF
1391    
1392      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1393         ztit='after fisrt'         ztit = 'after fisrt'
1394         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1395              , 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, &
1396              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1397         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &
1398              , 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, &
1399              , zero_v, rain_lsc, snow_lsc, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1400      END IF      END IF
1401    
1402      !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
1403    
1404      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1405    
1406      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke      IF (iflag_cldcon.le.-1) THEN ! seulement pour Tiedtke
1407         snow_tiedtke=0.         snow_tiedtke = 0.
1408         if (iflag_cldcon == -1) then         if (iflag_cldcon == -1) then
1409            rain_tiedtke=rain_con            rain_tiedtke = rain_con
1410         else         else
1411            rain_tiedtke=0.            rain_tiedtke = 0.
1412            do k=1, llm            do k = 1, llm
1413               do i=1, klon               do i = 1, klon
1414                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1415                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &
1416                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1417                  endif                  endif
1418               enddo               enddo
1419            enddo            enddo
1420         endif         endif
1421    
1422         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1423         CALL diagcld1(paprs, pplay, &         CALL diagcld1(paprs, play, &
1424              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &
1425              diafra, dialiq)              diafra, dialiq)
1426         DO k = 1, llm         DO k = 1, llm
1427            DO i = 1, klon            DO i = 1, klon
1428               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1429                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1430                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1431               ENDIF               ENDIF
1432            ENDDO            ENDDO
1433         ENDDO         ENDDO
   
1434      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1435         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1436         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1437         ! facttemps         ! facttemps
1438         facteur = pdtphys *facttemps         facteur = dtphys *facttemps
1439         do k=1, llm         do k = 1, llm
1440            do i=1, klon            do i = 1, klon
1441               rnebcon(i, k)=rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k)*facteur
1442               if (rnebcon0(i, k)*clwcon0(i, k).gt.rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1443                    then                    then
1444                  rnebcon(i, k)=rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1445                  clwcon(i, k)=clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1446               endif               endif
1447            enddo            enddo
1448         enddo         enddo
1449    
1450         !   On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
1451         cldfra=min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
1452         cldliq=cldliq+rnebcon*clwcon         cldliq = cldliq + rnebcon*clwcon
   
1453      ENDIF      ENDIF
1454    
1455      ! 2. NUAGES STARTIFORMES      ! 2. Nuages stratiformes
1456    
1457      IF (ok_stratus) THEN      IF (ok_stratus) THEN
1458         CALL diagcld2(paprs, pplay, t_seri, q_seri, diafra, dialiq)         CALL diagcld2(paprs, play, t_seri, q_seri, diafra, dialiq)
1459         DO k = 1, llm         DO k = 1, llm
1460            DO i = 1, klon            DO i = 1, klon
1461               IF (diafra(i, k).GT.cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
1462                  cldliq(i, k) = dialiq(i, k)                  cldliq(i, k) = dialiq(i, k)
1463                  cldfra(i, k) = diafra(i, k)                  cldfra(i, k) = diafra(i, k)
1464               ENDIF               ENDIF
# Line 1642  contains Line 1474  contains
1474      ENDDO      ENDDO
1475    
1476      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1477         ztit="after diagcld"         ztit = "after diagcld"
1478         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1479              , 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, &
1480              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1481      END IF      END IF
1482    
1483      ! Calculer l'humidite relative pour diagnostique      ! Humidité relative pour diagnostic:
   
1484      DO k = 1, llm      DO k = 1, llm
1485         DO i = 1, klon         DO i = 1, klon
1486            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1487            IF (thermcep) THEN            IF (thermcep) THEN
1488               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zdelta = MAX(0., SIGN(1., rtt-zx_t))
1489               zx_qs  = r2es * FOEEW(zx_t, zdelta)/pplay(i, k)               zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)
1490               zx_qs  = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1491               zcor   = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1492               zx_qs  = zx_qs*zcor               zx_qs = zx_qs*zcor
1493            ELSE            ELSE
1494               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
1495                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/play(i, k)
1496               ELSE               ELSE
1497                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/play(i, k)
1498               ENDIF               ENDIF
1499            ENDIF            ENDIF
1500            zx_rh(i, k) = q_seri(i, k)/zx_qs            zx_rh(i, k) = q_seri(i, k)/zx_qs
1501            zqsat(i, k)=zx_qs            zqsat(i, k) = zx_qs
1502         ENDDO         ENDDO
1503      ENDDO      ENDDO
1504      !jq - introduce the aerosol direct and first indirect radiative forcings  
1505      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      ! Introduce the aerosol direct and first indirect radiative forcings:
1506      IF (ok_ade.OR.ok_aie) THEN      ! Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1507        IF (ok_ade .OR. ok_aie) THEN
1508         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1509         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1510         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1511    
1512         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1513         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1514              tau_ae, piz_ae, cg_ae, aerindex)              aerindex)
1515      ELSE      ELSE
1516         tau_ae(:, :, :)=0.0         tau_ae = 0.
1517         piz_ae(:, :, :)=0.0         piz_ae = 0.
1518         cg_ae(:, :, :)=0.0         cg_ae = 0.
1519      ENDIF      ENDIF
1520    
1521      ! Calculer les parametres optiques des nuages et quelques      ! Paramètres optiques des nuages et quelques paramètres pour
1522      ! parametres pour diagnostiques:      ! diagnostics :
   
1523      if (ok_newmicro) then      if (ok_newmicro) then
1524         CALL newmicro (paprs, pplay, ok_newmicro, &         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &
1525              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &
1526              cldh, cldl, cldm, cldt, cldq, &              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &
1527              flwp, fiwp, flwc, fiwc, &              re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
1528      else      else
1529         CALL nuage (paprs, pplay, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1530              t_seri, cldliq, cldfra, cldtau, cldemi, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
1531              cldh, cldl, cldm, cldt, cldq, &              bl95_b1, cldtaupi, re, fl)
             ok_aie, &  
             sulfate, sulfate_pi, &  
             bl95_b0, bl95_b1, &  
             cldtaupi, re, fl)  
   
1532      endif      endif
1533    
1534      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
   
1535      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1536         DO i = 1, klon         DO i = 1, klon
1537            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
# Line 1723  contains Line 1544  contains
1544                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1545         ENDDO         ENDDO
1546         ! nouveau rayonnement (compatible Arpege-IFS):         ! nouveau rayonnement (compatible Arpege-IFS):
1547         CALL radlwsw(dist, rmu0, fract,  &         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &
1548              paprs, pplay, zxtsol, albsol, albsollw, t_seri, q_seri, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1549              wo, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1550              cldfra, cldemi, cldtau, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1551              heat, heat0, cool, cool0, radsol, albpla, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1552              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)  
1553         itaprad = 0         itaprad = 0
1554      ENDIF      ENDIF
1555      itaprad = itaprad + 1      itaprad = itaprad + 1
# Line 1746  contains Line 1558  contains
1558    
1559      DO k = 1, llm      DO k = 1, llm
1560         DO i = 1, klon         DO i = 1, klon
1561            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.
                + (heat(i, k)-cool(i, k)) * pdtphys/86400.  
1562         ENDDO         ENDDO
1563      ENDDO      ENDDO
1564    
1565      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1566         ztit='after rad'         ztit = 'after rad'
1567         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1568              , 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, &
1569              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1570         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, &
1571              , topsw, toplw, solsw, sollw, zero_v &              zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec, &
1572              , zero_v, zero_v, zero_v, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1573      END IF      END IF
1574    
1575      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
   
1576      DO i = 1, klon      DO i = 1, klon
1577         zxqsurf(i) = 0.0         zxqsurf(i) = 0.0
1578         zxsnow(i) = 0.0         zxsnow(i) = 0.0
# Line 1776  contains Line 1584  contains
1584         ENDDO         ENDDO
1585      ENDDO      ENDDO
1586    
1587      ! Calculer le bilan du sol et la derive de temperature (couplage)      ! Calculer le bilan du sol et la dérive de température (couplage)
1588    
1589      DO i = 1, klon      DO i = 1, klon
1590         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1591      ENDDO      ENDDO
1592    
1593      !mod deb lott(jan95)      ! Paramétrisation de l'orographie à l'échelle sous-maille :
     ! Appeler le programme de parametrisation de l'orographie  
     ! a l'echelle sous-maille:  
1594    
1595      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1596         !  selection des points pour lesquels le shema est actif:         ! selection des points pour lesquels le shema est actif:
1597         igwd=0         igwd = 0
1598         DO i=1, klon         DO i = 1, klon
1599            itest(i)=0            itest(i) = 0
1600            IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN
1601               itest(i)=1               itest(i) = 1
1602               igwd=igwd+1               igwd = igwd + 1
1603               idx(igwd)=i               idx(igwd) = i
1604            ENDIF            ENDIF
1605         ENDDO         ENDDO
1606    
1607         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1608              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &
1609              igwd, idx, itest, &              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
             t_seri, u_seri, v_seri, &  
             zulow, zvlow, zustrdr, zvstrdr, &  
             d_t_oro, d_u_oro, d_v_oro)  
1610    
1611         !  ajout des tendances         ! ajout des tendances
1612         DO k = 1, llm         DO k = 1, llm
1613            DO i = 1, klon            DO i = 1, klon
1614               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 1816  contains Line 1619  contains
1619      ENDIF      ENDIF
1620    
1621      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1622           ! Sélection des points pour lesquels le schéma est actif :
1623         !  selection des points pour lesquels le shema est actif:         igwd = 0
1624         igwd=0         DO i = 1, klon
1625         DO i=1, klon            itest(i) = 0
1626            itest(i)=0            IF ((zpic(i) - zmea(i)) > 100.) THEN
1627            IF ((zpic(i)-zmea(i)).GT.100.) THEN               itest(i) = 1
1628               itest(i)=1               igwd = igwd + 1
1629               igwd=igwd+1               idx(igwd) = i
              idx(igwd)=i  
1630            ENDIF            ENDIF
1631         ENDDO         ENDDO
1632    
1633         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &
1634              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, &  
1635              d_t_lif, d_u_lif, d_v_lif)              d_t_lif, d_u_lif, d_v_lif)
1636    
1637         !  ajout des tendances         ! Ajout des tendances :
1638         DO k = 1, llm         DO k = 1, llm
1639            DO i = 1, klon            DO i = 1, klon
1640               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)               t_seri(i, k) = t_seri(i, k) + d_t_lif(i, k)
# Line 1843  contains Line 1642  contains
1642               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)
1643            ENDDO            ENDDO
1644         ENDDO         ENDDO
1645        ENDIF
     ENDIF ! fin de test sur ok_orolf  
1646    
1647      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE      ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
1648    
1649      DO i = 1, klon      DO i = 1, klon
1650         zustrph(i)=0.         zustrph(i) = 0.
1651         zvstrph(i)=0.         zvstrph(i) = 0.
1652      ENDDO      ENDDO
1653      DO k = 1, llm      DO k = 1, llm
1654         DO i = 1, klon         DO i = 1, klon
1655            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &            zustrph(i) = zustrph(i) + (u_seri(i, k)-u(i, k))/dtphys* zmasse(i, k)
1656                 (paprs(i, k)-paprs(i, k+1))/rg            zvstrph(i) = zvstrph(i) + (v_seri(i, k)-v(i, k))/dtphys* zmasse(i, k)
           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1657         ENDDO         ENDDO
1658      ENDDO      ENDDO
1659    
1660      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1661    
1662      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, time, ra, rg, romega, rlat, rlon, pphis, &
1663           ra, rg, romega, &           zustrdr, zustrli, zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, &
          rlat, rlon, pphis, &  
          zustrdr, zustrli, zustrph, &  
          zvstrdr, zvstrli, zvstrph, &  
          paprs, u, v, &  
1664           aam, torsfc)           aam, torsfc)
1665    
1666      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1667         ztit='after orography'         ztit = 'after orography'
1668         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &
1669              , 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, &
1670              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1671      END IF      END IF
1672    
1673      !AA Installation de l'interface online-offline pour traceurs      ! Calcul des tendances traceurs
1674        call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, &
1675      !   Calcul  des tendances traceurs           nqmx-2, dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, &
1676             pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1677      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &           frac_impa, frac_nucl, pphis, albsol, rhcl, cldfra, rneb, &
1678           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1679           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           tr_seri, zmasse)
          frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &  
          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &  
          psfl, da, phi, mp, upwd, dnwd, tr_seri)  
1680    
1681      IF (offline) THEN      IF (offline) THEN
1682           call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1683         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1684         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)  
   
1685      ENDIF      ENDIF
1686    
1687      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1688        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1689             ue, uq)
1690    
1691      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1692    
1693      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, &  
1694           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1695    
1696      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
1697    
1698      !+jld ec_conser      ! conversion Ec -> E thermique
1699      DO k = 1, llm      DO k = 1, llm
1700         DO i = 1, klon         DO i = 1, klon
1701            ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i, k))            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))
1702            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k) = 0.5 / ZRCPD &
1703                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
1704            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
1705            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
1706         END DO         END DO
1707      END DO      END DO
1708      !-jld ec_conser  
1709      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1710         ztit='after physic'         ztit = 'after physic'
1711         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &
1712              , 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, &
1713              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              d_ql, d_qs, d_ec)
1714         !     Comme les tendances de la physique sont ajoute dans la dynamique,         ! Comme les tendances de la physique sont ajoute dans la dynamique,
1715         !     on devrait avoir que la variation d'entalpie par la dynamique         ! on devrait avoir que la variation d'entalpie par la dynamique
1716         !     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.
1717         !     Donc la somme de ces 2 variations devrait etre nulle.         ! Donc la somme de ces 2 variations devrait etre nulle.
1718         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil, topsw, toplw, solsw, sollw, sens, &
1719              , topsw, toplw, solsw, sollw, sens &              evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec, &
1720              , evap, rain_fall, snow_fall, ztsol &              fs_bound, fq_bound)
             , d_h_vcol, d_qt, d_ec &  
             , fs_bound, fq_bound )  
1721    
1722         d_h_vcol_phy=d_h_vcol         d_h_vcol_phy = d_h_vcol
1723    
1724      END IF      END IF
1725    
1726      !   SORTIES      ! SORTIES
   
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
1727    
1728      !cc prw = eau precipitable      !cc prw = eau precipitable
1729      DO i = 1, klon      DO i = 1, klon
1730         prw(i) = 0.         prw(i) = 0.
1731         DO k = 1, llm         DO k = 1, llm
1732            prw(i) = prw(i) + &            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)
                q_seri(i, k)*(paprs(i, k)-paprs(i, k+1))/RG  
1733         ENDDO         ENDDO
1734      ENDDO      ENDDO
1735    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1736      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1737    
1738      DO k = 1, llm      DO k = 1, llm
1739         DO i = 1, klon         DO i = 1, klon
1740            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys            d_u(i, k) = (u_seri(i, k) - u(i, k)) / dtphys
1741            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys            d_v(i, k) = (v_seri(i, k) - v(i, k)) / dtphys
1742            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys            d_t(i, k) = (t_seri(i, k) - t(i, k)) / dtphys
1743            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
1744            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
1745         ENDDO         ENDDO
1746      ENDDO      ENDDO
1747    
1748      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1749         DO iq = 3, nq         DO iq = 3, nqmx
1750            DO  k = 1, llm            DO k = 1, llm
1751               DO  i = 1, klon               DO i = 1, klon
1752                  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
1753               ENDDO               ENDDO
1754            ENDDO            ENDDO
1755         ENDDO         ENDDO
1756      ENDIF      ENDIF
1757    
1758      ! Sauvegarder les valeurs de t et q a la fin de la physique:      ! Sauvegarder les valeurs de t et q a la fin de la physique:
   
1759      DO k = 1, llm      DO k = 1, llm
1760         DO i = 1, klon         DO i = 1, klon
1761            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1993  contains Line 1763  contains
1763         ENDDO         ENDDO
1764      ENDDO      ENDDO
1765    
1766      !   Ecriture des sorties      ! Ecriture des sorties
   
1767      call write_histhf      call write_histhf
1768      call write_histday      call write_histday
1769      call write_histins      call write_histins
1770    
1771      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1772      IF (lafin) THEN      IF (lafin) THEN
1773         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1774         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1775              ftsoil, tslab, seaice, fqsurf, qsol, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1776              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &
1777              solsw, sollwdown, dlw, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1778              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)  
1779      ENDIF      ENDIF
1780    
1781    contains      firstcal = .FALSE.
   
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la  
       ! physique ou toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
1782    
1783      end SUBROUTINE calcul_STDlev    contains
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
   
       ! initialisations diverses au "debut" du mois  
   
       IF(MOD(itap, ecrit_mth) == 1) THEN  
          DO i=1, klon  
             nday_rain(i)=0.  
          ENDDO  
       ENDIF  
   
       IF(MOD(itap, ecrit_day) == 0) THEN  
          !IM calcul total_rain, nday_rain  
          DO i = 1, klon  
             total_rain(i)=rain_fall(i)+snow_fall(i)    
             IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.  
          ENDDO  
       ENDIF  
   
     End SUBROUTINE calcul_divers  
   
     !***********************************************  
1784    
1785      subroutine write_histday      subroutine write_histday
1786    
1787        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use gr_phy_write_3d_m, only: gr_phy_write_3d
1788          integer itau_w ! pas de temps ecriture
       if (ok_journe) THEN  
1789    
1790           ndex2d = 0        !------------------------------------------------
          ndex3d = 0  
   
          ! Champs 2D:  
1791    
1792          if (ok_journe) THEN
1793           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1794             if (nqmx <= 4) then
1795           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1796                     gr_phy_write_3d(wo) * 1e3)
1797                ! (convert "wo" from kDU to DU)
1798             end if
1799           if (ok_sync) then           if (ok_sync) then
1800              call histsync(nid_day)              call histsync(nid_day)
1801           endif           endif
   
1802        ENDIF        ENDIF
1803    
1804      End subroutine write_histday      End subroutine write_histday
# Line 2395  contains Line 1807  contains
1807    
1808      subroutine write_histhf      subroutine write_histhf
1809    
1810        ! 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
1811    
1812        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1813    
1814        call write_histhf3d        call write_histhf3d
1815    
# Line 2414  contains Line 1823  contains
1823    
1824      subroutine write_histins      subroutine write_histins
1825    
1826        ! 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
1827    
1828        real zout        real zout
1829          integer itau_w ! pas de temps ecriture
1830    
1831        !--------------------------------------------------        !--------------------------------------------------
1832    
1833        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1834           ! Champs 2D:           ! Champs 2D:
1835    
1836           zsto = pdtphys * ecrit_ins           zsto = dtphys * ecrit_ins
1837           zout = pdtphys * ecrit_ins           zout = dtphys * ecrit_ins
1838           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1839    
1840           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1841           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1842           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1843    
1844           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1845           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1846           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1847    
1848           DO i = 1, klon           DO i = 1, klon
1849              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1850           ENDDO           ENDDO
1851           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1852           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1853    
1854           DO i = 1, klon           DO i = 1, klon
1855              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1856           ENDDO           ENDDO
1857           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1858           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1859    
1860           DO i = 1, klon           DO i = 1, klon
1861              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1862           ENDDO           ENDDO
1863           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1864           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1865    
1866           DO i = 1, klon           DO i = 1, klon
1867              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
1868           ENDDO           ENDDO
1869           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1870           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
1871    
1872           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)
1873           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
1874           !ccIM           !ccIM
1875           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)
1876           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
1877    
1878           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)
1879           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
1880    
1881           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)
1882           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
1883    
1884           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)
1885           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
1886    
1887           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)
1888           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
1889    
1890           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)
1891           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
1892    
1893           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)
1894           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
1895    
1896           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)
1897           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
1898    
1899           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)
1900           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
1901    
1902           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)
1903           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
1904    
1905           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)
1906           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
1907    
1908           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)
1909           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
1910    
1911           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1912           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1913    
1914           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)
1915           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1916           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1917           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
1918    
1919           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)
1920           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
1921    
1922           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)
1923           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
1924    
1925           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)
1926           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
1927    
1928           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)
1929           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
1930    
1931           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)
1932           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
1933    
1934           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
1935              !XXX              !XXX
1936              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.
1937              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1938              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
1939                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1940    
1941              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)
1942              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1943              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
1944                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1945    
1946              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)
1947              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1948              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
1949                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1950    
1951              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)
1952              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1953              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
1954                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1955    
1956              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)
1957              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1958              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
1959                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1960    
1961              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)
1962              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1963              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
1964                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1965    
1966              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)
1967              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1968              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
1969                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1970    
1971              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)
1972              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1973              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1974                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1975    
1976              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)
1977              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1978              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1979                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
1980    
1981           END DO           END DO
1982           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1983           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
1984           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)
1985           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
1986    
1987           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1988           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
   
          !IM cf. AM 081204 BEG  
1989    
1990           !HBTM2           !HBTM2
1991    
1992           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)
1993           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
   
          CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)  
1994    
1995           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)
1996           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
1997    
1998           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)
1999           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
               ndex2d)  
2000    
2001           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)
2002           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
2003    
2004           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)
2005           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
2006    
2007           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)
2008           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
2009    
2010           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)
2011           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
2012    
2013           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)
2014           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
2015    
2016           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)
2017           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
2018    
2019           !IM cf. AM 081204 END           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)
2020             CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
2021    
2022           ! Champs 3D:           ! Champs 3D:
2023    
2024           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
2025           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
2026                iim*(jjm + 1)*llm, ndex3d)  
2027             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
2028           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
2029           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &  
2030                iim*(jjm + 1)*llm, ndex3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
2031             CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
2032           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
2033           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)
2034                iim*(jjm + 1)*llm, ndex3d)           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
2035    
2036           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)
2037           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
2038                iim*(jjm + 1)*llm, ndex3d)  
2039             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)
2040           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
2041           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &  
2042                iim*(jjm + 1)*llm, ndex3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
2043             CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &  
               iim*(jjm + 1)*llm, ndex3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &  
               iim*(jjm + 1)*llm, ndex3d)  
2044    
2045           if (ok_sync) then           if (ok_sync) then
2046              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2670  contains Line 2053  contains
2053    
2054      subroutine write_histhf3d      subroutine write_histhf3d
2055    
2056        ! 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
2057    
2058          integer itau_w ! pas de temps ecriture
2059    
2060        ndex2d = 0        !-------------------------------------------------------
       ndex3d = 0  
2061    
2062        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2063    
2064        ! Champs 3D:        ! Champs 3D:
2065    
2066        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)
2067        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
2068             iim*(jjm + 1)*llm, ndex3d)  
2069          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, qx(1, 1, ivap), zx_tmp_3d)
2070        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
2071        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &  
2072             iim*(jjm + 1)*llm, ndex3d)        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)
2073          CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
2074        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)  
2075        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)
2076             iim*(jjm + 1)*llm, ndex3d)        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
   
       CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)  
       CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &  
            iim*(jjm + 1)*llm, ndex3d)  
2077    
2078        if (nbtr >= 3) then        if (nbtr >= 3) then
2079           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, tr_seri(1, 1, 3), &
2080                zx_tmp_3d)                zx_tmp_3d)
2081           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, &           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
               ndex3d)  
2082        end if        end if
2083    
2084        if (ok_sync) then        if (ok_sync) then
# Line 2710  contains Line 2089  contains
2089    
2090    END SUBROUTINE physiq    END SUBROUTINE physiq
2091    
   !****************************************************  
   
   FUNCTION qcheck(klon, klev, paprs, q, ql, aire)  
   
     ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28  
   
     use YOMCST  
     IMPLICIT none  
   
     ! Calculer et imprimer l'eau totale. A utiliser pour verifier  
     ! la conservation de l'eau  
   
     INTEGER klon, klev  
     REAL, intent(in):: paprs(klon, klev+1)  
     real q(klon, klev), ql(klon, klev)  
     REAL aire(klon)  
     REAL qtotal, zx, qcheck  
     INTEGER i, k  
   
     zx = 0.0  
     DO i = 1, klon  
        zx = zx + aire(i)  
     ENDDO  
     qtotal = 0.0  
     DO k = 1, klev  
        DO i = 1, klon  
           qtotal = qtotal + (q(i, k)+ql(i, k)) * aire(i) &  
                *(paprs(i, k)-paprs(i, k+1))/RG  
        ENDDO  
     ENDDO  
   
     qcheck = qtotal/zx  
   
   END FUNCTION qcheck  
   
2092  end module physiq_m  end module physiq_m
Legend:
Removed from v.13  
changed lines
  Added in v.53
  ViewVC Help
Powered by ViewVC 1.1.21