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

Diff of /trunk/Sources/phylmd/physiq.f

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

revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC revision 34 by guez, Wed Jun 2 11:01:12 2010 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         pplay, pphi, pphis, u, v, t, qx, omega, d_u, d_v, &
14         d_t, d_qx, d_ps, dudyn, PVteta)         d_t, d_qx, d_ps, dudyn, PVteta)
15    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28
# Line 23  contains Line 23  contains
23      !AA                  -  stockage des moyennes des champs necessaires      !AA                  -  stockage des moyennes des champs necessaires
24      !AA                     en mode traceur off-line      !AA                     en mode traceur off-line
25    
     USE ioipsl, only: ymds2ju, histwrite, histsync  
     use dimens_m, only: jjm, iim, llm  
     use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &  
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline, iphysiq  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref, itaufin  
     use clesphys, only: ecrit_hf, ecrit_hf2mth, &  
          ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &  
          nbapp_rad, cycle_diurne, cdmmax, cdhmax, &  
          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &  
          ok_kzmin, soil_model  
     use iniprint, only: lunout, prt_level  
26      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
27      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      USE calendar, only: ymds2ju
28        use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
29             cdmmax, cdhmax, &
30             co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
31             ok_kzmin
32        use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
33             cycle_diurne, new_oliq, soil_model
34      use comgeomphy      use comgeomphy
35        use conf_gcm_m, only: raz_date, offline
36        use conf_phys_m, only: conf_phys
37      use ctherm      use ctherm
38      use phytrac_m, only: phytrac      use dimens_m, only: jjm, iim, llm, nqmx
39        use dimphy, only: klon, nbtr
40        use dimsoil, only: nsoilmx
41        use hgardfou_m, only: hgardfou
42        USE histcom, only: histsync
43        USE histwrite_m, only: histwrite
44        use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
45             clnsurf, epsfra
46        use ini_histhf_m, only: ini_histhf
47        use ini_histday_m, only: ini_histday
48        use ini_histins_m, only: ini_histins
49        use iniprint, only: prt_level
50      use oasis_m      use oasis_m
51        use orbite_m, only: orbite, zenang
52        use ozonecm_m, only: ozonecm
53        use phyetat0_m, only: phyetat0, rlat, rlon
54        use phyredem_m, only: phyredem
55        use phystokenc_m, only: phystokenc
56        use phytrac_m, only: phytrac
57        use qcheck_m, only: qcheck
58      use radepsi      use radepsi
59      use radopt      use radopt
60        use temps, only: itau_phy, day_ref, annee_ref
61      use yoethf      use yoethf
62      use ini_hist, only: ini_histhf, ini_histday, ini_histins      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
     use orbite_m, only: orbite, zenang  
     use phyetat0_m, only: phyetat0, rlat, rlon  
     use hgardfou_m, only: hgardfou  
     use conf_phys_m, only: conf_phys  
63    
64      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
65      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
66    
67      ! Variables argument:      ! Variables argument:
68    
69      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      REAL, intent(in):: rdayvrai
70      REAL rjourvrai ! input numero du jour de l'experience      ! (elapsed time since January 1st 0h of the starting year, in days)
71    
72      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
73      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
74      LOGICAL, intent(in):: debut ! premier passage      LOGICAL, intent(in):: firstcal ! first call to "calfis"
75      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
76    
77      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
78      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
79        
80      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
81      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
82    
83      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 75  contains Line 85  contains
85    
86      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
87    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
88      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s
89      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s
90      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
91    
92      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nqmx)
93      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
94    
95      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
96      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
97      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)
98      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)
99      REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)
100      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon)  ! output tendance physique de la pression au sol
101    
102      INTEGER nbteta      INTEGER nbteta
# Line 112  contains Line 119  contains
119      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
120      logical rnpb      logical rnpb
121      parameter(rnpb=.true.)      parameter(rnpb=.true.)
122      !      ocean = type de modele ocean a utiliser: force, slab, couple  
123      character(len=6) ocean      character(len=6), save:: ocean
124      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
125    
126      logical ok_ocean      logical ok_ocean
127      SAVE ok_ocean      SAVE ok_ocean
# Line 128  contains Line 135  contains
135      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
136    
137      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
138      logical ok_veget      logical, save:: ok_veget
139      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
140    
141      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
142    
# Line 178  contains Line 183  contains
183      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
184      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
185    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
186      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
187      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
188      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
189    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
190      !IM Amip2      !IM Amip2
191      ! variables a une pression donnee      ! variables a une pression donnee
192    
# Line 204  contains Line 201  contains
201           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
202           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
203    
     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  
   
204      ! prw: precipitable water      ! prw: precipitable water
205      real prw(klon)      real prw(klon)
206    
# Line 263  contains Line 209  contains
209      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
210      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
211    
212      INTEGER l, kmax, lmax      INTEGER kmax, lmax
213      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
214      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
215      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 315  contains Line 261  contains
261      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
262      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
263    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
   
264      ! Variables propres a la physique      ! Variables propres a la physique
265    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
266      INTEGER, save:: radpas      INTEGER, save:: radpas
267      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
268      ! "physiq".)      ! "physiq".)
# Line 335  contains Line 270  contains
270      REAL radsol(klon)      REAL radsol(klon)
271      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
272    
273      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
274    
275      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
276      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 364  contains Line 297  contains
297      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
298      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
299    
300      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
301        REAL, save:: zmea(klon) ! orographie moyenne
302      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
303      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
304        REAL, save:: zgam(klon) ! anisotropie de l'OESM
305      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
306      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
307        REAL, save:: zval(klon) ! Minimum de l'OESM
308      REAL zsig(klon)      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
     SAVE zsig                   ! pente de l'OESM  
   
     REAL zgam(klon)  
     save zgam                   ! anisotropie de l'OESM  
   
     REAL zthe(klon)  
     SAVE zthe                   ! orientation de l'OESM  
   
     REAL zpic(klon)  
     SAVE zpic                   ! Maximum de l'OESM  
   
     REAL zval(klon)  
     SAVE zval                   ! Minimum de l'OESM  
   
     REAL rugoro(klon)  
     SAVE rugoro                 ! longueur de rugosite de l'OESM  
309    
310      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
311    
# Line 449  contains Line 366  contains
366      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
367      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
368    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
369      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
370      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
371      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 472  contains Line 386  contains
386    
387      INTEGER julien      INTEGER julien
388    
389      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
390      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
391      !IM      !IM
392      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
# Line 483  contains Line 397  contains
397      REAL albsollw(klon)      REAL albsollw(klon)
398      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
399    
400      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
401    
402      ! Declaration des procedures appelees      ! Declaration des procedures appelees
403    
# Line 494  contains Line 408  contains
408      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
409      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
410      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
411      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
412      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
413    
     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  
   
414      ! Variables locales      ! Variables locales
415    
416      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 649  contains Line 558  contains
558      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
559    
560      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
561      real fact_cldcon      real, save:: fact_cldcon
562      real facttemps      real, save:: facttemps
563      logical ok_newmicro      logical ok_newmicro
564      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
565      real facteur      real facteur
566    
567      integer iflag_cldcon      integer iflag_cldcon
# Line 661  contains Line 569  contains
569    
570      logical ptconv(klon, llm)      logical ptconv(klon, llm)
571    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
572      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
573    
574      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 676  contains Line 580  contains
580    
581      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
582    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
583      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
584      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
585      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
# Line 690  contains Line 588  contains
588      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
589    
590      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
   
591      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)
592    
593      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
594    
595      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.
596      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 720  contains Line 615  contains
615      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
616      SAVE      ip_ebil      SAVE      ip_ebil
617      DATA      ip_ebil/0/      DATA      ip_ebil/0/
618      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
619      !+jld ec_conser      !+jld ec_conser
620      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique      REAL d_t_ec(klon, llm)    ! tendance du a la conersion Ec -> E thermique
621      REAL ZRCPD      REAL ZRCPD
# Line 793  contains Line 687  contains
687      SAVE trmb2      SAVE trmb2
688      SAVE trmb3      SAVE trmb3
689    
690        real zmasse(klon, llm)
691        ! (column-density of mass of air in a cell, in kg m-2)
692    
693        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
694    
695      !----------------------------------------------------------------      !----------------------------------------------------------------
696    
697      modname = 'physiq'      modname = 'physiq'
# Line 802  contains Line 701  contains
701         END DO         END DO
702      END IF      END IF
703      ok_sync=.TRUE.      ok_sync=.TRUE.
704      IF (nq .LT. 2) THEN      IF (nqmx  <  2) THEN
705         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
706         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
707      ENDIF      ENDIF
708    
709      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
   
     test_debut: IF (debut) THEN  
710         !  initialiser         !  initialiser
711         u10m(:, :)=0.         u10m=0.
712         v10m(:, :)=0.         v10m=0.
713         t2m(:, :)=0.         t2m=0.
714         q2m(:, :)=0.         q2m=0.
715         ffonte(:, :)=0.         ffonte=0.
716         fqcalving(:, :)=0.         fqcalving=0.
717         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
718         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
719         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 829  contains Line 726  contains
726         solswai(:)=0.         solswai(:)=0.
727         solswad(:)=0.         solswad(:)=0.
728    
729         d_u_con(:, :) = 0.0         d_u_con = 0.0
730         d_v_con(:, :) = 0.0         d_v_con = 0.0
731         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
732         clwcon0(:, :) = 0.0         clwcon0 = 0.0
733         rnebcon(:, :) = 0.0         rnebcon = 0.0
734         clwcon(:, :) = 0.0         clwcon = 0.0
735    
736         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
737         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
738         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
739         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
740         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
741         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
742         therm(:, :)  =0.         therm  =0.
743         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
744         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
745         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
746    
747         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
748    
# Line 863  contains Line 760  contains
760         frugs = 0.         frugs = 0.
761         itap = 0         itap = 0
762         itaprad = 0         itaprad = 0
763         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
764              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
765              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
766              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
767              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
768              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
769              run_off_lic_0)              run_off_lic_0)
770    
771         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
772         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
773    
774         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
775    
776         ! on remet le calendrier a zero         ! on remet le calendrier a zero
777           IF (raz_date) itau_phy = 0
778    
779         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
780    
781         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
782            ok_ocean=.TRUE.            ok_ocean=.TRUE.
783         ENDIF         ENDIF
784    
785         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
786              ok_instan, ok_region )              ok_region)
   
        IF (ABS(dtime-pdtphys).GT.0.001) THEN  
           WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &  
                pdtphys  
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
787    
788         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
789            WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
790            WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
791            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
792            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
793         ENDIF         ENDIF
794         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
795         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
796              ok_cvl              ok_cvl
797    
798         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
799         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
800    
801            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
802    
803            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
804            DO i = 1, klon            DO i = 1, klon
# Line 925  contains Line 810  contains
810         ENDIF         ENDIF
811    
812         IF (ok_orodr) THEN         IF (ok_orodr) THEN
813            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
814            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
815           else
816              rugoro = 0.
817         ENDIF         ENDIF
818    
819         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
820         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
821    
822         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
823         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
824         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
825         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
826         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
827    
828         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
829    
830         npas = 0         npas = 0
831         nexca = 0         nexca = 0
        if (ocean == 'couple') then  
           npas = itaufin/ iphysiq  
           nexca = 86400 / int(dtime)  
           write(lunout, *)' Ocean couple'  
           write(lunout, *)' Valeurs des pas de temps'  
           write(lunout, *)' npas = ', npas  
           write(lunout, *)' nexca = ', nexca  
        endif  
832    
833         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
834    
835         !   Initialisation des sorties         !   Initialisation des sorties
836    
837         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
838         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
839         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
840         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
841         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
842         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
843      ENDIF test_debut      ENDIF test_firstcal
844    
845      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
846    
# Line 978  contains Line 854  contains
854            d_v(i, k) = 0.0            d_v(i, k) = 0.0
855         ENDDO         ENDDO
856      ENDDO      ENDDO
857      DO iq = 1, nq      DO iq = 1, nqmx
858         DO k = 1, llm         DO k = 1, llm
859            DO i = 1, klon            DO i = 1, klon
860               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
861            ENDDO            ENDDO
862         ENDDO         ENDDO
863      ENDDO      ENDDO
864      da(:, :)=0.      da=0.
865      mp(:, :)=0.      mp=0.
866      phi(:, :, :)=0.      phi(:, :, :)=0.
867    
868      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
# Line 1001  contains Line 877  contains
877            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
878         ENDDO         ENDDO
879      ENDDO      ENDDO
880      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
881         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
882      ELSE      ELSE
883         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
884      ENDIF      ENDIF
# Line 1018  contains Line 894  contains
894    
895      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
896         ztit='after dynamic'         ztit='after dynamic'
897         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
898              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
899              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
900         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
901         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1037  contains Line 913  contains
913      IF (ancien_ok) THEN      IF (ancien_ok) THEN
914         DO k = 1, llm         DO k = 1, llm
915            DO i = 1, klon            DO i = 1, klon
916               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtime               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys
917               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtime               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys
918            ENDDO            ENDDO
919         ENDDO         ENDDO
920      ELSE      ELSE
# Line 1065  contains Line 941  contains
941    
942      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
943    
944      itap   = itap + 1      itap = itap + 1
945      julien = MOD(NINT(xjour), 360)      julien = MOD(NINT(rdayvrai), 360)
946      if (julien == 0) julien = 360      if (julien == 0) julien = 360
947    
948        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
949    
950      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
951      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
952    
953      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nqmx >= 5) then
954         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
955        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
956           wo = ozonecm(REAL(julien), paprs)
957      ENDIF      ENDIF
958    
959      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1094  contains Line 974  contains
974    
975      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
976         ztit='after reevap'         ztit='after reevap'
977         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
978              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
979              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
980         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
981              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1125  contains Line 1005  contains
1005    
1006      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1007      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1008         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1009         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1010      ELSE      ELSE
1011         rmu0 = -999.999         rmu0 = -999.999
# Line 1154  contains Line 1034  contains
1034    
1035      fder = dlw      fder = dlw
1036    
1037      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1038           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1039           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1040           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1164  contains Line 1044  contains
1044           fluxlat, rain_fall, snow_fall, &           fluxlat, rain_fall, snow_fall, &
1045           fsolsw, fsollw, sollwdown, fder, &           fsolsw, fsollw, sollwdown, fder, &
1046           rlon, rlat, cuphy, cvphy, frugs, &           rlon, rlat, cuphy, cvphy, frugs, &
1047           debut, lafin, agesno, rugoro, &           firstcal, lafin, agesno, rugoro, &
1048           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
1049           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
1050           q2, dsens, devap, &           q2, dsens, devap, &
# Line 1211  contains Line 1091  contains
1091    
1092      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1093         ztit='after clmain'         ztit='after clmain'
1094         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1095              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1096              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1097         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1098              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1282  contains Line 1162  contains
1162    
1163      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1164         DO i = 1, klon         DO i = 1, klon
1165            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
1166    
1167            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
1168            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
1169            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
1170            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
1171            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
1172            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf)  <  epsfra)  &
1173                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1174            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
1175            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
1176            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
1177            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1178            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1179            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
1180            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
1181            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
1182            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
1183            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
1184         ENDDO         ENDDO
1185      ENDDO      ENDDO
1186    
# Line 1315  contains Line 1195  contains
1195      DO k = 1, llm      DO k = 1, llm
1196         DO i = 1, klon         DO i = 1, klon
1197            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1198                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1199            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1200                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1201         ENDDO         ENDDO
1202      ENDDO      ENDDO
1203      IF (check) THEN      IF (check) THEN
1204         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1205         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1206      ENDIF      ENDIF
1207      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1208      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1333  contains Line 1213  contains
1213         DO k = 1, llm         DO k = 1, llm
1214            DO i = 1, klon            DO i = 1, klon
1215               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)) &
1216                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1217            ENDDO            ENDDO
1218         ENDDO         ENDDO
1219      ENDIF      ENDIF
1220      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1221         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1222      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1223         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1224              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1225              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1226              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1361  contains Line 1241  contains
1241         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1242    
1243         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1244              CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
           CALL concvl (iflag_con, &  
                dtime, paprs, pplay, t_seri, q_seri, &  
1245                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1246                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1247                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1375  contains Line 1253  contains
1253                 da, phi, mp)                 da, phi, mp)
1254    
1255            clwcon0=qcondc            clwcon0=qcondc
1256            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1257         ELSE ! ok_cvl         ELSE ! ok_cvl
1258            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1259            CALL conema3 (dtime, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1260                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1261                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1262                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1390  contains Line 1266  contains
1266                 pbase &                 pbase &
1267                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1268                 , clwcon0)                 , clwcon0)
   
1269         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1270    
1271         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1411  contains Line 1286  contains
1286                  zcor   = 1./(1.-retv*zx_qs)                  zcor   = 1./(1.-retv*zx_qs)
1287                  zx_qs  = zx_qs*zcor                  zx_qs  = zx_qs*zcor
1288               ELSE               ELSE
1289                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1290                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/pplay(i, k)
1291                  ELSE                  ELSE
1292                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1422  contains Line 1297  contains
1297         ENDDO         ENDDO
1298    
1299         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1300         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1301         call clouds_gno &         call clouds_gno &
1302              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1303      ELSE      ELSE
1304         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1305         stop 1         stop 1
1306      ENDIF      ENDIF
1307    
# Line 1441  contains Line 1316  contains
1316    
1317      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1318         ztit='after convect'         ztit='after convect'
1319         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1320              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1321              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1322         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1323              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1453  contains Line 1328  contains
1328    
1329      IF (check) THEN      IF (check) THEN
1330         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1331         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1332         zx_t = 0.0         zx_t = 0.0
1333         za = 0.0         za = 0.0
1334         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1336  contains
1336            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1337                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1338         ENDDO         ENDDO
1339         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1340         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1341      ENDIF      ENDIF
1342      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1343         DO i = 1, klon         DO i = 1, klon
# Line 1471  contains Line 1346  contains
1346         DO k = 1, llm         DO k = 1, llm
1347            DO i = 1, klon            DO i = 1, klon
1348               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)) &
1349                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1350            ENDDO            ENDDO
1351         ENDDO         ENDDO
1352         DO i = 1, klon         DO i = 1, klon
1353            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &
1354                 /z_apres(i)                 /z_apres(i)
1355         ENDDO         ENDDO
1356         DO k = 1, llm         DO k = 1, llm
1357            DO i = 1, klon            DO i = 1, klon
1358               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
1359                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1360                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1361               ENDIF               ENDIF
1362            ENDDO            ENDDO
# Line 1491  contains Line 1366  contains
1366    
1367      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1368    
1369      d_t_ajs(:, :)=0.      d_t_ajs=0.
1370      d_u_ajs(:, :)=0.      d_u_ajs=0.
1371      d_v_ajs(:, :)=0.      d_v_ajs=0.
1372      d_q_ajs(:, :)=0.      d_q_ajs=0.
1373      fm_therm(:, :)=0.      fm_therm=0.
1374      entr_therm(:, :)=0.      entr_therm=0.
1375    
1376      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1377           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1378           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1379      if(iflag_thermals.lt.0) then      if(iflag_thermals < 0) then
1380         !  Rien         !  Rien
1381         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1382      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1383         !  Ajustement sec         !  Ajustement sec
1384         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1385         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1386         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1387         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1388      else      else
1389         !  Thermiques         !  Thermiques
1390         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1391              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1392         call calltherm(pdtphys &         call calltherm(pdtphys &
1393              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1523  contains Line 1398  contains
1398    
1399      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1400         ztit='after dry_adjust'         ztit='after dry_adjust'
1401         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1402              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1403              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1404      END IF      END IF
1405    
# Line 1560  contains Line 1435  contains
1435         !   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
1436         !   relaxation des ratqs         !   relaxation des ratqs
1437         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1438         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1439         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1440      else      else
1441         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1442         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1443      endif      endif
1444    
1445      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1446      ! et le processus de precipitation      ! et le processus de precipitation
1447      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1448           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1449           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1450           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1590  contains Line 1465  contains
1465      ENDDO      ENDDO
1466      IF (check) THEN      IF (check) THEN
1467         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1468         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1469         zx_t = 0.0         zx_t = 0.0
1470         za = 0.0         za = 0.0
1471         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1473  contains
1473            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1474                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1475         ENDDO         ENDDO
1476         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1477         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1478      ENDIF      ENDIF
1479    
1480      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1481         ztit='after fisrt'         ztit='after fisrt'
1482         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1483              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1484              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1485         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1486              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1626  contains Line 1501  contains
1501            rain_tiedtke=0.            rain_tiedtke=0.
1502            do k=1, llm            do k=1, llm
1503               do i=1, klon               do i=1, klon
1504                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1505                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1506                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1507                  endif                  endif
1508               enddo               enddo
1509            enddo            enddo
# Line 1648  contains Line 1523  contains
1523         ENDDO         ENDDO
1524    
1525      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1526         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1527         !  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
1528         !  facttemps         ! facttemps
1529         facteur = pdtphys *facttemps         facteur = pdtphys *facttemps
1530         do k=1, llm         do k=1, llm
1531            do i=1, klon            do i=1, klon
# Line 1664  contains Line 1539  contains
1539         enddo         enddo
1540    
1541         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1542         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1543         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1544    
1545      ENDIF      ENDIF
1546    
# Line 1692  contains Line 1567  contains
1567    
1568      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1569         ztit="after diagcld"         ztit="after diagcld"
1570         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1571              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1572              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1573      END IF      END IF
1574    
# Line 1709  contains Line 1584  contains
1584               zcor   = 1./(1.-retv*zx_qs)               zcor   = 1./(1.-retv*zx_qs)
1585               zx_qs  = zx_qs*zcor               zx_qs  = zx_qs*zcor
1586            ELSE            ELSE
1587               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1588                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/pplay(i, k)
1589               ELSE               ELSE
1590                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1723  contains Line 1598  contains
1598      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1599      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1600         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1601         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1602         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1603    
1604         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1605         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
# Line 1796  contains Line 1671  contains
1671      DO k = 1, llm      DO k = 1, llm
1672         DO i = 1, klon         DO i = 1, klon
1673            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1674                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1675         ENDDO         ENDDO
1676      ENDDO      ENDDO
1677    
1678      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1679         ztit='after rad'         ztit='after rad'
1680         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1681              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1682              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1683         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1684              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1831  contains Line 1706  contains
1706         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1707      ENDDO      ENDDO
1708    
1709      !moddeblott(jan95)      !mod deb lott(jan95)
1710      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1711      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1712    
1713      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1714         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1715         igwd=0         igwd=0
1716         DO i=1, klon         DO i=1, klon
# Line 1848  contains Line 1722  contains
1722            ENDIF            ENDIF
1723         ENDDO         ENDDO
1724    
1725         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1726              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1727              igwd, idx, itest, &              igwd, idx, itest, &
1728              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1863  contains Line 1737  contains
1737               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
1738            ENDDO            ENDDO
1739         ENDDO         ENDDO
1740        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1741    
1742      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1743    
# Line 1879  contains Line 1752  contains
1752            ENDIF            ENDIF
1753         ENDDO         ENDDO
1754    
1755         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1756              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1757              itest, &              itest, &
1758              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1905  contains Line 1778  contains
1778      ENDDO      ENDDO
1779      DO k = 1, llm      DO k = 1, llm
1780         DO i = 1, klon         DO i = 1, klon
1781            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)
1782                 (paprs(i, k)-paprs(i, k+1))/rg            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* zmasse(i, k)
           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1783         ENDDO         ENDDO
1784      ENDDO      ENDDO
1785    
1786      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1787    
1788      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1789           ra, rg, romega, &           ra, rg, romega, &
1790           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1791           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1924  contains Line 1795  contains
1795    
1796      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1797         ztit='after orography'         ztit='after orography'
1798         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1799              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1800              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1801      END IF      END IF
1802    
1803      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
1804        call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nqmx-2, &
1805      !   Calcul  des tendances traceurs           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1806             pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1807      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1808           dtime, u, v, t, paprs, pplay, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1809           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           tr_seri, zmasse)
          ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &  
          pctsrf, frac_impa,  frac_nucl, &  
          presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &  
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1810    
1811      IF (offline) THEN      IF (offline) THEN
1812           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1813         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1814         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, 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, dtime, itap)  
   
1815      ENDIF      ENDIF
1816    
1817      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1818        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1819             ue, uq)
1820    
1821      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1822    
1823      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1824           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1977  contains Line 1833  contains
1833            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1834                 *(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)
1835            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)
1836            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1837         END DO         END DO
1838      END DO      END DO
1839      !-jld ec_conser      !-jld ec_conser
1840      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1841         ztit='after physic'         ztit='after physic'
1842         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1843              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1844              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1845         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1846         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 2002  contains Line 1858  contains
1858    
1859      !   SORTIES      !   SORTIES
1860    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1861      !cc prw = eau precipitable      !cc prw = eau precipitable
1862      DO i = 1, klon      DO i = 1, klon
1863         prw(i) = 0.         prw(i) = 0.
1864         DO k = 1, llm         DO k = 1, llm
1865            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  
1866         ENDDO         ENDDO
1867      ENDDO      ENDDO
1868    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1869      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1870    
1871      DO k = 1, llm      DO k = 1, llm
1872         DO i = 1, klon         DO i = 1, klon
1873            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1874            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1875            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1876            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtime            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys
1877            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtime            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys
1878         ENDDO         ENDDO
1879      ENDDO      ENDDO
1880    
1881      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1882         DO iq = 3, nq         DO iq = 3, nqmx
1883            DO  k = 1, llm            DO  k = 1, llm
1884               DO  i = 1, klon               DO  i = 1, klon
1885                  d_qx(i, k, iq) = ( tr_seri(i, k, iq-2) - qx(i, k, iq) ) / dtime                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
1886               ENDDO               ENDDO
1887            ENDDO            ENDDO
1888         ENDDO         ENDDO
1889      ENDIF      ENDIF
1890    
1891      ! 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:
   
1892      DO k = 1, llm      DO k = 1, llm
1893         DO i = 1, klon         DO i = 1, klon
1894            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2049  contains Line 1897  contains
1897      ENDDO      ENDDO
1898    
1899      !   Ecriture des sorties      !   Ecriture des sorties
   
1900      call write_histhf      call write_histhf
1901      call write_histday      call write_histday
1902      call write_histins      call write_histins
1903    
1904      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1905      IF (lafin) THEN      IF (lafin) THEN
1906         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1907         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
1908              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
1909              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1910              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
1911              radsol, frugs, agesno, &              radsol, frugs, agesno, &
1912              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1913              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1914      ENDIF      ENDIF
1915    
1916    contains    contains
1917    
     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  
       !IM 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)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     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  
   
     !***********************************************  
   
1918      subroutine write_histday      subroutine write_histday
1919    
1920        !     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
1921          integer itau_w  ! pas de temps ecriture
       if (ok_journe) THEN  
   
          ndex2d = 0  
          ndex3d = 0  
1922    
1923           ! Champs 2D:        !------------------------------------------------
1924    
1925          if (ok_journe) THEN
1926           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1927             if (nqmx <= 4) then
1928           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1929                     gr_phy_write_3d(wo) * 1e3)
1930                ! (convert "wo" from kDU to DU)
1931             end if
1932           if (ok_sync) then           if (ok_sync) then
1933              call histsync(nid_day)              call histsync(nid_day)
1934           endif           endif
   
1935        ENDIF        ENDIF
1936    
1937      End subroutine write_histday      End subroutine write_histday
# Line 2454  contains Line 1942  contains
1942    
1943        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09        ! From phylmd/write_histhf.h, v 1.5 2005/05/25 13:10:09
1944    
1945        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1946    
1947        call write_histhf3d        call write_histhf3d
1948    
# Line 2474  contains Line 1959  contains
1959        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, v 1.2 2005/05/25 13:10:09
1960    
1961        real zout        real zout
1962          integer itau_w  ! pas de temps ecriture
1963    
1964        !--------------------------------------------------        !--------------------------------------------------
1965    
1966        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1967           ! Champs 2D:           ! Champs 2D:
1968    
1969           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
1970           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
1971           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1972    
1973           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1974           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)
1975           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1976    
1977           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1978           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)
1979           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1980    
1981           DO i = 1, klon           DO i = 1, klon
1982              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1983           ENDDO           ENDDO
1984           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)
1985           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1986    
1987           DO i = 1, klon           DO i = 1, klon
1988              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1989           ENDDO           ENDDO
1990           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)
1991           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1992    
1993           DO i = 1, klon           DO i = 1, klon
1994              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1995           ENDDO           ENDDO
1996           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)
1997           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1998    
1999           DO i = 1, klon           DO i = 1, klon
2000              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2001           ENDDO           ENDDO
2002           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)
2003           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2004    
2005           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)
2006           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2007           !ccIM           !ccIM
2008           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)
2009           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2010    
2011           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)
2012           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2013    
2014           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)
2015           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2016    
2017           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)
2018           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2019    
2020           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)
2021           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2022    
2023           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)
2024           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2025    
2026           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)
2027           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2028    
2029           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)
2030           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2031    
2032           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)
2033           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2034    
2035           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)
2036           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2037    
2038           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)
2039           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2040    
2041           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)
2042           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2043    
2044           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)
2045           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2046    
2047           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2048           !     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)
2049           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)
2050           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2051    
2052           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)
2053           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2054    
2055           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)
2056           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2057    
2058           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)
2059           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2060    
2061           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)
2062           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2063    
2064           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)
2065           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2066    
2067           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2068              !XXX              !XXX
2069              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2070              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)
2071              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2072                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2073    
2074              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2075              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)
2076              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2077                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2078    
2079              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2080              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)
2081              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2082                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2083    
2084              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2085              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)
2086              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2087                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2088    
2089              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2090              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)
2091              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2092                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2093    
2094              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2095              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)
2096              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2097                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2098    
2099              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2100              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)
2101              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2102                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2103    
2104              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2105              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)
2106              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2107                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2108    
2109              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2110              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)
2111              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2112                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2113    
2114           END DO           END DO
2115           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)
2116           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2117           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)
2118           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2119    
2120           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)
2121           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2122    
2123           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2124    
2125           !HBTM2           !HBTM2
2126    
2127           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)
2128           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)
2129    
2130           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)
2131           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
2132    
2133           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)
2134           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
2135    
2136           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)
2137           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
2138    
2139           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)
2140           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
2141    
2142           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)
2143           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
2144    
2145           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)
2146           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
2147    
2148           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)
2149           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
2150    
2151           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)
2152           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
2153    
2154           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)
2155           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
               ndex2d)  
2156    
2157           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2158    
2159           ! Champs 3D:           ! Champs 3D:
2160    
2161           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)
2162           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2163    
2164           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2165           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2166    
2167           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2168           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2169    
2170           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)
2171           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2172    
2173           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)
2174           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2175    
2176           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)
2177           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2178    
2179           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)
2180           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2181    
2182           if (ok_sync) then           if (ok_sync) then
2183              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2729  contains Line 2192  contains
2192    
2193        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09        ! From phylmd/write_histhf3d.h, v 1.2 2005/05/25 13:10:09
2194    
2195        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2196        ndex3d = 0  
2197          !-------------------------------------------------------
2198    
2199        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2200    
2201        ! Champs 3D:        ! Champs 3D:
2202    
2203        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)
2204        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2205    
2206        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)
2207        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2208    
2209        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2210        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2211    
2212        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2213        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2214    
2215        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &        if (nbtr >= 3) then
2216             zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &
2217        CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, ndex3d)                zx_tmp_3d)
2218             CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
2219          end if
2220    
2221        if (ok_sync) then        if (ok_sync) then
2222           call histsync(nid_hf3d)           call histsync(nid_hf3d)
# Line 2764  contains Line 2226  contains
2226    
2227    END SUBROUTINE physiq    END SUBROUTINE physiq
2228    
   !****************************************************  
   
   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  
   
2229  end module physiq_m  end module physiq_m
Legend:
Removed from v.3  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.21