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

Diff of /trunk/phylmd/physiq.f

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

revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(nq, 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    
26      USE ioipsl, only: ymds2ju, histwrite, histsync      USE calendar, only: ymds2ju
27        USE histwrite_m, only: histwrite
28        USE histcom, only: histsync
29      use dimens_m, only: jjm, iim, llm      use dimens_m, only: jjm, iim, llm
30      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
31           clnsurf, epsfra           clnsurf, epsfra
32      use dimphy, only: klon, nbtr      use dimphy, only: klon, nbtr
33      use conf_gcm_m, only: raz_date, offline, iphysiq      use conf_gcm_m, only: raz_date, offline
34      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
35      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref
36      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
37           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &           cdmmax, cdhmax, &
38           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
39           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &           ok_kzmin
40           ok_kzmin, soil_model      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
41      use iniprint, only: lunout, prt_level           cycle_diurne, new_oliq, soil_model
42        use iniprint, only: prt_level
43      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
44      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
45      use comgeomphy      use comgeomphy
# Line 51  contains Line 54  contains
54      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
55      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
56      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
57        use phyredem_m, only: phyredem
58        use qcheck_m, only: qcheck
59        use ozonecm_m, only: ozonecm
60    
61      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
62      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
63    
64      ! Variables argument:      ! Variables argument:
65    
66      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)
67      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience  
68        REAL, intent(in):: rdayvrai
69        ! (elapsed time since January 1st 0h of the starting year, in days)
70    
71      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
72      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
73      LOGICAL, intent(in):: firstcal ! first call to "calfis"      LOGICAL, intent(in):: firstcal ! first call to "calfis"
74      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
75    
76      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
77      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
78        
79      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
80      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
81    
82      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 75  contains Line 84  contains
84    
85      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
86    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
87      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
88      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
89      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
90    
91      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nq)
92      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)
93    
94      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
95      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)
# Line 112  contains Line 118  contains
118      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
119      logical rnpb      logical rnpb
120      parameter(rnpb=.true.)      parameter(rnpb=.true.)
121      !      ocean = type de modele ocean a utiliser: force, slab, couple  
122      character(len=6) ocean      character(len=6), save:: ocean
123      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
124    
125      logical ok_ocean      logical ok_ocean
126      SAVE ok_ocean      SAVE ok_ocean
# Line 128  contains Line 134  contains
134      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
135    
136      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
137      logical ok_veget      logical, save:: ok_veget
138      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
139    
140      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
141    
# Line 178  contains Line 182  contains
182      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
183      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
184    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
185      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
186      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
187      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
188    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
189      !IM Amip2      !IM Amip2
190      ! variables a une pression donnee      ! variables a une pression donnee
191    
# Line 204  contains Line 200  contains
200           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
201           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
202    
     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  
   
203      ! prw: precipitable water      ! prw: precipitable water
204      real prw(klon)      real prw(klon)
205    
# Line 263  contains Line 208  contains
208      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
209      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
210    
211      INTEGER l, kmax, lmax      INTEGER kmax, lmax
212      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
213      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
214      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 315  contains Line 260  contains
260      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
261      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
262    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles      )  
   
263      ! Variables propres a la physique      ! Variables propres a la physique
264    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
265      INTEGER, save:: radpas      INTEGER, save:: radpas
266      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
267      ! "physiq".)      ! "physiq".)
# Line 331  contains Line 270  contains
270      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
271    
272      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
273    
274      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
275      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 359  contains Line 296  contains
296      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
297      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
298    
299      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
300        REAL, save:: zmea(klon) ! orographie moyenne
301      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
302      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
303        REAL, save:: zgam(klon) ! anisotropie de l'OESM
304      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
305      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
306        REAL, save:: zval(klon) ! Minimum de l'OESM
307      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  
308    
309      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
310    
# Line 444  contains Line 365  contains
365      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
366      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
367    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
368      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
369      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
370      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 478  contains Line 396  contains
396      REAL albsollw(klon)      REAL albsollw(klon)
397      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
398    
399      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
400    
401      ! Declaration des procedures appelees      ! Declaration des procedures appelees
402    
# Line 489  contains Line 407  contains
407      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
408      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
409      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  
410      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
411      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
412    
     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)  
   
413      ! Variables locales      ! Variables locales
414    
415      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 646  contains Line 557  contains
557      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
558    
559      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
560      real fact_cldcon      real, save:: fact_cldcon
561      real facttemps      real, save:: facttemps
562      logical ok_newmicro      logical ok_newmicro
563      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
564      real facteur      real facteur
565    
566      integer iflag_cldcon      integer iflag_cldcon
# Line 658  contains Line 568  contains
568    
569      logical ptconv(klon, llm)      logical ptconv(klon, llm)
570    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
571      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
572    
573      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 673  contains Line 579  contains
579    
580      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
581    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
582      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
583      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
584      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
# Line 687  contains Line 587  contains
587      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
588    
589      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  
   
590      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)
591    
592      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
593    
594      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.
595      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 717  contains Line 614  contains
614      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
615      SAVE      ip_ebil      SAVE      ip_ebil
616      DATA      ip_ebil/0/      DATA      ip_ebil/0/
617      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
618      !+jld ec_conser      !+jld ec_conser
619      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
620      REAL ZRCPD      REAL ZRCPD
# Line 790  contains Line 686  contains
686      SAVE trmb2      SAVE trmb2
687      SAVE trmb3      SAVE trmb3
688    
689        real zmasse(klon, llm)
690        ! (column-density of mass of air in a cell, in kg m-2)
691    
692        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
693    
694      !----------------------------------------------------------------      !----------------------------------------------------------------
695    
696      modname = 'physiq'      modname = 'physiq'
# Line 801  contains Line 702  contains
702      ok_sync=.TRUE.      ok_sync=.TRUE.
703      IF (nq  <  2) THEN      IF (nq  <  2) THEN
704         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
705         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
706      ENDIF      ENDIF
707    
708      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
709         !  initialiser         !  initialiser
710         u10m(:, :)=0.         u10m=0.
711         v10m(:, :)=0.         v10m=0.
712         t2m(:, :)=0.         t2m=0.
713         q2m(:, :)=0.         q2m=0.
714         ffonte(:, :)=0.         ffonte=0.
715         fqcalving(:, :)=0.         fqcalving=0.
716         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
717         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
718         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 824  contains Line 725  contains
725         solswai(:)=0.         solswai(:)=0.
726         solswad(:)=0.         solswad(:)=0.
727    
728         d_u_con(:, :) = 0.0         d_u_con = 0.0
729         d_v_con(:, :) = 0.0         d_v_con = 0.0
730         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
731         clwcon0(:, :) = 0.0         clwcon0 = 0.0
732         rnebcon(:, :) = 0.0         rnebcon = 0.0
733         clwcon(:, :) = 0.0         clwcon = 0.0
734    
735         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
736         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
737         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
738         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
739         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
740         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
741         therm(:, :)  =0.         therm  =0.
742         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
743         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
744         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
745    
746         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
747    
# Line 858  contains Line 759  contains
759         frugs = 0.         frugs = 0.
760         itap = 0         itap = 0
761         itaprad = 0         itaprad = 0
762         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
763              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
764              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
765              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
766              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
767              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
768              run_off_lic_0)              run_off_lic_0)
769    
770         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
771         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
772    
773         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
774    
775         ! on remet le calendrier a zero         ! on remet le calendrier a zero
776           IF (raz_date) itau_phy = 0
777    
778         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
779    
780         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
781            ok_ocean=.TRUE.            ok_ocean=.TRUE.
782         ENDIF         ENDIF
783    
784         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
785              ok_instan, ok_region )              ok_region)
786    
787         IF (ABS(dtime-pdtphys).GT.0.001) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
788            WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &            print *,'Nbre d appels au rayonnement insuffisant'
789                 pdtphys            print *,"Au minimum 4 appels par jour si cycle diurne"
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
   
        IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN  
           WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'  
           WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"  
790            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
791            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
792         ENDIF         ENDIF
793         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
794         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
795              ok_cvl              ok_cvl
796    
797         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
798         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
799    
800            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
801    
802            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
803            DO i = 1, klon            DO i = 1, klon
# Line 920  contains Line 809  contains
809         ENDIF         ENDIF
810    
811         IF (ok_orodr) THEN         IF (ok_orodr) THEN
812            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
813            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
814           else
815              rugoro = 0.
816         ENDIF         ENDIF
817    
818         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
819         print *, 'Number of time steps of "physics" per day: ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
820    
821         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
822         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
823         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
824         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
825         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
826    
827         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
828    
829         npas = 0         npas = 0
830         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  
831    
832         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
833    
834         !   Initialisation des sorties         !   Initialisation des sorties
835    
836         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
837         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nq)
838         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
839         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
840         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
841         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 980  contains Line 860  contains
860            ENDDO            ENDDO
861         ENDDO         ENDDO
862      ENDDO      ENDDO
863      da(:, :)=0.      da=0.
864      mp(:, :)=0.      mp=0.
865      phi(:, :, :)=0.      phi(:, :, :)=0.
866    
867      ! 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 1013  contains Line 893  contains
893    
894      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
895         ztit='after dynamic'         ztit='after dynamic'
896         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
897              , 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 &
898              , 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)
899         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
900         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1032  contains Line 912  contains
912      IF (ancien_ok) THEN      IF (ancien_ok) THEN
913         DO k = 1, llm         DO k = 1, llm
914            DO i = 1, klon            DO i = 1, klon
915               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
916               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
917            ENDDO            ENDDO
918         ENDDO         ENDDO
919      ELSE      ELSE
# Line 1064  contains Line 944  contains
944      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
945      if (julien == 0) julien = 360      if (julien == 0) julien = 360
946    
947        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
948    
949      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
950      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
951    
952      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nq >= 5) then
953         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
954        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
955           wo = ozonecm(REAL(julien), paprs)
956      ENDIF      ENDIF
957    
958      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1089  contains Line 973  contains
973    
974      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
975         ztit='after reevap'         ztit='after reevap'
976         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
977              , 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 &
978              , 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)
979         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
980              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1120  contains Line 1004  contains
1004    
1005      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1006      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1007         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1008         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1009      ELSE      ELSE
1010         rmu0 = -999.999         rmu0 = -999.999
# Line 1149  contains Line 1033  contains
1033    
1034      fder = dlw      fder = dlw
1035    
1036      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1037           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1038           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1039           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1206  contains Line 1090  contains
1090    
1091      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1092         ztit='after clmain'         ztit='after clmain'
1093         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1094              , 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 &
1095              , 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)
1096         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1097              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1310  contains Line 1194  contains
1194      DO k = 1, llm      DO k = 1, llm
1195         DO i = 1, klon         DO i = 1, klon
1196            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1197                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1198            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1199                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1200         ENDDO         ENDDO
1201      ENDDO      ENDDO
1202      IF (check) THEN      IF (check) THEN
1203         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1204         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1205      ENDIF      ENDIF
1206      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1207      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1328  contains Line 1212  contains
1212         DO k = 1, llm         DO k = 1, llm
1213            DO i = 1, klon            DO i = 1, klon
1214               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)) &
1215                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1216            ENDDO            ENDDO
1217         ENDDO         ENDDO
1218      ENDIF      ENDIF
1219      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1220         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1221      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1222         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1223              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1224              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1225              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1356  contains Line 1240  contains
1240         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1241    
1242         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1243              CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
           CALL concvl (iflag_con, &  
                dtime, paprs, pplay, t_seri, q_seri, &  
1244                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1245                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1246                 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 1370  contains Line 1252  contains
1252                 da, phi, mp)                 da, phi, mp)
1253    
1254            clwcon0=qcondc            clwcon0=qcondc
1255            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1256         ELSE ! ok_cvl         ELSE ! ok_cvl
1257            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1258            CALL conema3 (dtime, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1259                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1260                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1261                 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 1385  contains Line 1265  contains
1265                 pbase &                 pbase &
1266                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1267                 , clwcon0)                 , clwcon0)
   
1268         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1269    
1270         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1417  contains Line 1296  contains
1296         ENDDO         ENDDO
1297    
1298         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1299         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1300         call clouds_gno &         call clouds_gno &
1301              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1302      ELSE      ELSE
1303         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1304         stop 1         stop 1
1305      ENDIF      ENDIF
1306    
# Line 1436  contains Line 1315  contains
1315    
1316      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1317         ztit='after convect'         ztit='after convect'
1318         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1319              , 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 &
1320              , 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)
1321         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1322              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1448  contains Line 1327  contains
1327    
1328      IF (check) THEN      IF (check) THEN
1329         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1330         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1331         zx_t = 0.0         zx_t = 0.0
1332         za = 0.0         za = 0.0
1333         DO i = 1, klon         DO i = 1, klon
# Line 1456  contains Line 1335  contains
1335            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1336                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1337         ENDDO         ENDDO
1338         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1339         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1340      ENDIF      ENDIF
1341      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1342         DO i = 1, klon         DO i = 1, klon
# Line 1466  contains Line 1345  contains
1345         DO k = 1, llm         DO k = 1, llm
1346            DO i = 1, klon            DO i = 1, klon
1347               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)) &
1348                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1349            ENDDO            ENDDO
1350         ENDDO         ENDDO
1351         DO i = 1, klon         DO i = 1, klon
1352            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) &
1353                 /z_apres(i)                 /z_apres(i)
1354         ENDDO         ENDDO
1355         DO k = 1, llm         DO k = 1, llm
# Line 1486  contains Line 1365  contains
1365    
1366      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1367    
1368      d_t_ajs(:, :)=0.      d_t_ajs=0.
1369      d_u_ajs(:, :)=0.      d_u_ajs=0.
1370      d_v_ajs(:, :)=0.      d_v_ajs=0.
1371      d_q_ajs(:, :)=0.      d_q_ajs=0.
1372      fm_therm(:, :)=0.      fm_therm=0.
1373      entr_therm(:, :)=0.      entr_therm=0.
1374    
1375      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1376           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1377           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1378      if(iflag_thermals < 0) then      if(iflag_thermals < 0) then
1379         !  Rien         !  Rien
1380         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1381      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1382         !  Ajustement sec         !  Ajustement sec
1383         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1384         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)
1385         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1386         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1387      else      else
1388         !  Thermiques         !  Thermiques
1389         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1390              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1391         call calltherm(pdtphys &         call calltherm(pdtphys &
1392              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1518  contains Line 1397  contains
1397    
1398      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1399         ztit='after dry_adjust'         ztit='after dry_adjust'
1400         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1401              , 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 &
1402              , 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)
1403      END IF      END IF
1404    
# Line 1555  contains Line 1434  contains
1434         !   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
1435         !   relaxation des ratqs         !   relaxation des ratqs
1436         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1437         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1438         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1439      else      else
1440         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1441         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1442      endif      endif
1443    
1444      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1445      ! et le processus de precipitation      ! et le processus de precipitation
1446      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1447           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1448           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1449           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1585  contains Line 1464  contains
1464      ENDDO      ENDDO
1465      IF (check) THEN      IF (check) THEN
1466         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1467         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1468         zx_t = 0.0         zx_t = 0.0
1469         za = 0.0         za = 0.0
1470         DO i = 1, klon         DO i = 1, klon
# Line 1593  contains Line 1472  contains
1472            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1473                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1474         ENDDO         ENDDO
1475         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1476         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1477      ENDIF      ENDIF
1478    
1479      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1480         ztit='after fisrt'         ztit='after fisrt'
1481         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1482              , 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 &
1483              , 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)
1484         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1485              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1623  contains Line 1502  contains
1502               do i=1, klon               do i=1, klon
1503                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1504                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1505                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1506                  endif                  endif
1507               enddo               enddo
1508            enddo            enddo
# Line 1659  contains Line 1538  contains
1538         enddo         enddo
1539    
1540         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1541         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1542         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1543    
1544      ENDIF      ENDIF
1545    
# Line 1687  contains Line 1566  contains
1566    
1567      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1568         ztit="after diagcld"         ztit="after diagcld"
1569         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1570              , 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 &
1571              , 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)
1572      END IF      END IF
1573    
# Line 1791  contains Line 1670  contains
1670      DO k = 1, llm      DO k = 1, llm
1671         DO i = 1, klon         DO i = 1, klon
1672            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1673                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1674         ENDDO         ENDDO
1675      ENDDO      ENDDO
1676    
1677      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1678         ztit='after rad'         ztit='after rad'
1679         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1680              , 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 &
1681              , 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)
1682         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1683              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1826  contains Line 1705  contains
1705         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1706      ENDDO      ENDDO
1707    
1708      !moddeblott(jan95)      !mod deb lott(jan95)
1709      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1710      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1711    
1712      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1713         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1714         igwd=0         igwd=0
1715         DO i=1, klon         DO i=1, klon
# Line 1843  contains Line 1721  contains
1721            ENDIF            ENDIF
1722         ENDDO         ENDDO
1723    
1724         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1725              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1726              igwd, idx, itest, &              igwd, idx, itest, &
1727              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1858  contains Line 1736  contains
1736               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)
1737            ENDDO            ENDDO
1738         ENDDO         ENDDO
1739        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1740    
1741      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1742    
# Line 1874  contains Line 1751  contains
1751            ENDIF            ENDIF
1752         ENDDO         ENDDO
1753    
1754         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1755              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1756              itest, &              itest, &
1757              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1900  contains Line 1777  contains
1777      ENDDO      ENDDO
1778      DO k = 1, llm      DO k = 1, llm
1779         DO i = 1, klon         DO i = 1, klon
1780            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)
1781                 (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  
1782         ENDDO         ENDDO
1783      ENDDO      ENDDO
1784    
1785      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1786    
1787      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1788           ra, rg, romega, &           ra, rg, romega, &
1789           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1790           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1919  contains Line 1794  contains
1794    
1795      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1796         ztit='after orography'         ztit='after orography'
1797         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1798              , 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 &
1799              , 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)
1800      END IF      END IF
1801    
1802      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
   
     !   Calcul  des tendances traceurs  
   
1803      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1804           dtime, u, v, t, paprs, pplay, &           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1805           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1806           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &
1807           pctsrf, frac_impa,  frac_nucl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1808           presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1809    
1810      IF (offline) THEN      IF (offline) THEN
1811           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1812         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1813         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)  
   
1814      ENDIF      ENDIF
1815    
1816      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1817        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1818             ue, uq)
1819    
1820      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1821    
1822      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1823           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1972  contains Line 1832  contains
1832            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1833                 *(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)
1834            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)
1835            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1836         END DO         END DO
1837      END DO      END DO
1838      !-jld ec_conser      !-jld ec_conser
1839      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1840         ztit='after physic'         ztit='after physic'
1841         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1842              , 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 &
1843              , 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)
1844         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1845         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1997  contains Line 1857  contains
1857    
1858      !   SORTIES      !   SORTIES
1859    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1860      !cc prw = eau precipitable      !cc prw = eau precipitable
1861      DO i = 1, klon      DO i = 1, klon
1862         prw(i) = 0.         prw(i) = 0.
1863         DO k = 1, llm         DO k = 1, llm
1864            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  
1865         ENDDO         ENDDO
1866      ENDDO      ENDDO
1867    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1868      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1869    
1870      DO k = 1, llm      DO k = 1, llm
1871         DO i = 1, klon         DO i = 1, klon
1872            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1873            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1874            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1875            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
1876            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
1877         ENDDO         ENDDO
1878      ENDDO      ENDDO
1879    
# Line 2028  contains Line 1881  contains
1881         DO iq = 3, nq         DO iq = 3, nq
1882            DO  k = 1, llm            DO  k = 1, llm
1883               DO  i = 1, klon               DO  i = 1, klon
1884                  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
1885               ENDDO               ENDDO
1886            ENDDO            ENDDO
1887         ENDDO         ENDDO
1888      ENDIF      ENDIF
1889    
1890      ! 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:
   
1891      DO k = 1, llm      DO k = 1, llm
1892         DO i = 1, klon         DO i = 1, klon
1893            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2044  contains Line 1896  contains
1896      ENDDO      ENDDO
1897    
1898      !   Ecriture des sorties      !   Ecriture des sorties
   
1899      call write_histhf      call write_histhf
1900      call write_histday      call write_histday
1901      call write_histins      call write_histins
1902    
1903      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1904      IF (lafin) THEN      IF (lafin) THEN
1905         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1906         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
1907              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
1908              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1909              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
1910              radsol, frugs, agesno, &              radsol, frugs, agesno, &
1911              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1912              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1913      ENDIF      ENDIF
1914    
1915    contains    contains
1916    
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la  
       ! physique ou toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     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  
   
     !***********************************************  
   
1917      subroutine write_histday      subroutine write_histday
1918    
1919        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use grid_change, only: gr_phy_write_3d
1920          integer itau_w  ! pas de temps ecriture
1921    
1922        if (ok_journe) THEN        !------------------------------------------------
   
          ndex2d = 0  
          ndex3d = 0  
   
          ! Champs 2D:  
1923    
1924          if (ok_journe) THEN
1925           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1926             if (nq <= 4) then
1927           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1928                     gr_phy_write_3d(wo) * 1e3)
1929                ! (convert "wo" from kDU to DU)
1930             end if
1931           if (ok_sync) then           if (ok_sync) then
1932              call histsync(nid_day)              call histsync(nid_day)
1933           endif           endif
   
1934        ENDIF        ENDIF
1935    
1936      End subroutine write_histday      End subroutine write_histday
# Line 2449  contains Line 1941  contains
1941    
1942        ! 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
1943    
1944        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1945    
1946        call write_histhf3d        call write_histhf3d
1947    
# Line 2469  contains Line 1958  contains
1958        ! 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
1959    
1960        real zout        real zout
1961          integer itau_w  ! pas de temps ecriture
1962    
1963        !--------------------------------------------------        !--------------------------------------------------
1964    
1965        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1966           ! Champs 2D:           ! Champs 2D:
1967    
1968           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
1969           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
1970           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1971    
1972           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1973           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)
1974           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1975    
1976           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1977           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)
1978           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1979    
1980           DO i = 1, klon           DO i = 1, klon
1981              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1982           ENDDO           ENDDO
1983           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)
1984           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1985    
1986           DO i = 1, klon           DO i = 1, klon
1987              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1988           ENDDO           ENDDO
1989           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)
1990           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1991    
1992           DO i = 1, klon           DO i = 1, klon
1993              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1994           ENDDO           ENDDO
1995           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)
1996           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
1997    
1998           DO i = 1, klon           DO i = 1, klon
1999              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2000           ENDDO           ENDDO
2001           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)
2002           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2003    
2004           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)
2005           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2006           !ccIM           !ccIM
2007           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)
2008           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2009    
2010           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)
2011           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2012    
2013           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)
2014           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2015    
2016           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)
2017           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2018    
2019           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)
2020           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2021    
2022           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)
2023           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2024    
2025           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)
2026           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2027    
2028           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)
2029           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2030    
2031           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)
2032           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2033    
2034           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)
2035           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2036    
2037           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)
2038           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2039    
2040           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)
2041           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2042    
2043           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)
2044           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2045    
2046           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2047           !     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)
2048           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)
2049           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2050    
2051           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)
2052           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2053    
2054           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)
2055           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2056    
2057           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)
2058           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2059    
2060           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)
2061           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2062    
2063           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)
2064           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2065    
2066           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2067              !XXX              !XXX
2068              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2069              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)
2070              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2071                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2072    
2073              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2074              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)
2075              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2076                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2077    
2078              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2079              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)
2080              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2081                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2082    
2083              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2084              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)
2085              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2086                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2087    
2088              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2089              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)
2090              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2091                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2092    
2093              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2094              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)
2095              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2096                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2097    
2098              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2099              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)
2100              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2101                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2102    
2103              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2104              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)
2105              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2106                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2107    
2108              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2109              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)
2110              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2111                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2112    
2113           END DO           END DO
2114           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)
2115           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2116           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)
2117           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2118    
2119           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)
2120           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2121    
2122           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2123    
2124           !HBTM2           !HBTM2
2125    
2126           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)
2127           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)
2128    
2129           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)
2130           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)
2131    
2132           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)
2133           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)
2134    
2135           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)
2136           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)  
2137    
2138           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)
2139           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)  
2140    
2141           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)
2142           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)  
2143    
2144           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)
2145           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)  
2146    
2147           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)
2148           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)  
2149    
2150           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)
2151           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)  
2152    
2153           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)
2154           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)  
2155    
2156           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2157    
2158           ! Champs 3D:           ! Champs 3D:
2159    
2160           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)
2161           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)  
2162    
2163           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)
2164           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)  
2165    
2166           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)
2167           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)  
2168    
2169           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)
2170           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)  
2171    
2172           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)
2173           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)  
2174    
2175           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)
2176           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)  
2177    
2178           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)
2179           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)  
2180    
2181           if (ok_sync) then           if (ok_sync) then
2182              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2724  contains Line 2191  contains
2191    
2192        ! 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
2193    
2194        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2195        ndex3d = 0  
2196          !-------------------------------------------------------
2197    
2198        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2199    
2200        ! Champs 3D:        ! Champs 3D:
2201    
2202        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)
2203        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)  
2204    
2205        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)
2206        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)  
2207    
2208        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)
2209        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)  
2210    
2211        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)
2212        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)  
2213    
2214        if (nbtr >= 3) then        if (nbtr >= 3) then
2215           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &
2216                zx_tmp_3d)                zx_tmp_3d)
2217           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, &           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
               ndex3d)  
2218        end if        end if
2219    
2220        if (ok_sync) then        if (ok_sync) then
# Line 2762  contains Line 2225  contains
2225    
2226    END SUBROUTINE physiq    END SUBROUTINE physiq
2227    
   !****************************************************  
   
   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  
   
2228  end module physiq_m  end module physiq_m
Legend:
Removed from v.7  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.21