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

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

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

revision 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 20 by guez, Wed Oct 15 16:19:57 2008 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(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 31  contains Line 31  contains
31      use conf_gcm_m, only: raz_date, offline, iphysiq      use conf_gcm_m, only: raz_date, offline, iphysiq
32      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
33      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref, itaufin
34      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
35           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &           cdmmax, cdhmax, &
36           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
37           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &           ok_kzmin
38           ok_kzmin, soil_model      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
39      use iniprint, only: lunout, prt_level           cycle_diurne, new_oliq, soil_model
40        use iniprint, only: prt_level
41      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
42      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
43      use comgeomphy      use comgeomphy
# Line 51  contains Line 52  contains
52      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
53      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
54      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
55        use phyredem_m, only: phyredem
56        use qcheck_m, only: qcheck
57    
58      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
59      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
60    
61      ! Variables argument:      ! Variables argument:
62    
63      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER, intent(in):: nq ! nombre de traceurs (y compris vapeur d'eau)
64      REAL rjourvrai ! input numero du jour de l'experience  
65        REAL, intent(in):: rdayvrai
66        ! (elapsed time since January 1st 0h of the starting year, in days)
67    
68      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
69      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
70      LOGICAL, intent(in):: debut ! premier passage      LOGICAL, intent(in):: firstcal ! first call to "calfis"
71      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
72    
73      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
74      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
75        
76      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
77      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
78    
79      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 75  contains Line 81  contains
81    
82      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
83    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
84      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
85      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
86      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
87    
88      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nq)
89      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)
90    
91      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
92      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 115  contains
115      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
116      logical rnpb      logical rnpb
117      parameter(rnpb=.true.)      parameter(rnpb=.true.)
118      !      ocean = type de modele ocean a utiliser: force, slab, couple  
119      character(len=6) ocean      character(len=6), save:: ocean
120      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
121    
122      logical ok_ocean      logical ok_ocean
123      SAVE ok_ocean      SAVE ok_ocean
# Line 128  contains Line 131  contains
131      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
132    
133      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
134      logical ok_veget      logical, save:: ok_veget
135      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
136    
137      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
138    
# Line 213  contains Line 214  contains
214      INTEGER nout      INTEGER nout
215      PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC      PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC
216    
     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  
   
217      logical oknondef(klon, nlevSTD, nout)      logical oknondef(klon, nlevSTD, nout)
218      real tnondef(klon, nlevSTD, nout)      real tnondef(klon, nlevSTD, nout)
219      save tnondef      save tnondef
# Line 234  contains Line 227  contains
227      real vTSTD(klon, nlevSTD)      real vTSTD(klon, nlevSTD)
228      real wqSTD(klon, nlevSTD)      real wqSTD(klon, nlevSTD)
229    
     real uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
230      real vphiSTD(klon, nlevSTD)      real vphiSTD(klon, nlevSTD)
231      real wTSTD(klon, nlevSTD)      real wTSTD(klon, nlevSTD)
232      real u2STD(klon, nlevSTD)      real u2STD(klon, nlevSTD)
233      real v2STD(klon, nlevSTD)      real v2STD(klon, nlevSTD)
234      real T2STD(klon, nlevSTD)      real T2STD(klon, nlevSTD)
235    
     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  
   
236      ! prw: precipitable water      ! prw: precipitable water
237      real prw(klon)      real prw(klon)
238    
# Line 317  contains Line 295  contains
295    
296      INTEGER        longcles      INTEGER        longcles
297      PARAMETER    ( longcles = 20 )      PARAMETER    ( longcles = 20 )
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
298    
299      ! Variables propres a la physique      ! Variables propres a la physique
300    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
301      INTEGER, save:: radpas      INTEGER, save:: radpas
302      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
303      ! "physiq".)      ! "physiq".)
# Line 335  contains Line 305  contains
305      REAL radsol(klon)      REAL radsol(klon)
306      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
307    
308      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
309    
310      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
311      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 364  contains Line 332  contains
332      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
333      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
334    
335      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
336        REAL, save:: zmea(klon) ! orographie moyenne
337      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
338      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
339        REAL, save:: zgam(klon) ! anisotropie de l'OESM
340      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
341      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
342        REAL, save:: zval(klon) ! Minimum de l'OESM
343      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  
344    
345      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
346    
# Line 449  contains Line 401  contains
401      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
402      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
403    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
404      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
405      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
406      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 472  contains Line 421  contains
421    
422      INTEGER julien      INTEGER julien
423    
424      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
425      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
426      !IM      !IM
427      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
# Line 483  contains Line 432  contains
432      REAL albsollw(klon)      REAL albsollw(klon)
433      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
434    
435      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
436    
437      ! Declaration des procedures appelees      ! Declaration des procedures appelees
438    
# Line 495  contains Line 444  contains
444      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
445      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
446      EXTERNAL ozonecm   ! prescrire l'ozone      EXTERNAL ozonecm   ! prescrire l'ozone
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
447      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
448      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
449    
     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  
   
450      ! Variables locales      ! Variables locales
451    
452      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 649  contains Line 594  contains
594      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
595    
596      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
597      real fact_cldcon      real, save:: fact_cldcon
598      real facttemps      real, save:: facttemps
599      logical ok_newmicro      logical ok_newmicro
600      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
601      real facteur      real facteur
602    
603      integer iflag_cldcon      integer iflag_cldcon
# Line 661  contains Line 605  contains
605    
606      logical ptconv(klon, llm)      logical ptconv(klon, llm)
607    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
608      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
609    
610      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 676  contains Line 616  contains
616    
617      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
618    
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
   
619      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
620      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
621      REAL zustrph(klon), zvstrph(klon)      REAL zustrph(klon), zvstrph(klon)
# Line 694  contains Line 628  contains
628    
629      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)
630    
631      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
632    
633      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.
634      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 720  contains Line 653  contains
653      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
654      SAVE      ip_ebil      SAVE      ip_ebil
655      DATA      ip_ebil/0/      DATA      ip_ebil/0/
656      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
657      !+jld ec_conser      !+jld ec_conser
658      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
659      REAL ZRCPD      REAL ZRCPD
# Line 793  contains Line 725  contains
725      SAVE trmb2      SAVE trmb2
726      SAVE trmb3      SAVE trmb3
727    
728        real zmasse(klon, llm)
729        ! (column-density of mass of air in a cell, in kg m-2)
730    
731        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
732    
733      !----------------------------------------------------------------      !----------------------------------------------------------------
734    
735      modname = 'physiq'      modname = 'physiq'
# Line 802  contains Line 739  contains
739         END DO         END DO
740      END IF      END IF
741      ok_sync=.TRUE.      ok_sync=.TRUE.
742      IF (nq .LT. 2) THEN      IF (nq  <  2) THEN
743         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
744         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
745      ENDIF      ENDIF
746    
747      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
   
     test_debut: IF (debut) THEN  
748         !  initialiser         !  initialiser
749         u10m(:, :)=0.         u10m=0.
750         v10m(:, :)=0.         v10m=0.
751         t2m(:, :)=0.         t2m=0.
752         q2m(:, :)=0.         q2m=0.
753         ffonte(:, :)=0.         ffonte=0.
754         fqcalving(:, :)=0.         fqcalving=0.
755         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
756         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
757         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 829  contains Line 764  contains
764         solswai(:)=0.         solswai(:)=0.
765         solswad(:)=0.         solswad(:)=0.
766    
767         d_u_con(:, :) = 0.0         d_u_con = 0.0
768         d_v_con(:, :) = 0.0         d_v_con = 0.0
769         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
770         clwcon0(:, :) = 0.0         clwcon0 = 0.0
771         rnebcon(:, :) = 0.0         rnebcon = 0.0
772         clwcon(:, :) = 0.0         clwcon = 0.0
773    
774         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
775         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
776         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
777         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
778         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
779         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
780         therm(:, :)  =0.         therm  =0.
781         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
782         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
783         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
784    
785         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
786    
# Line 863  contains Line 798  contains
798         frugs = 0.         frugs = 0.
799         itap = 0         itap = 0
800         itaprad = 0         itaprad = 0
801         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
802              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
803              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
804              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
805              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
806              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
807              run_off_lic_0)              run_off_lic_0)
808    
809         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
810         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
811    
812         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
813    
814         ! on remet le calendrier a zero         ! on remet le calendrier a zero
815           IF (raz_date) itau_phy = 0
816    
817         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
818    
819         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
820            ok_ocean=.TRUE.            ok_ocean=.TRUE.
821         ENDIF         ENDIF
822    
823         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
824              ok_instan, ok_region )              ok_region)
   
        IF (ABS(dtime-pdtphys).GT.0.001) THEN  
           WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &  
                pdtphys  
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
825    
826         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
827            WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
828            WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
829            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
830            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
831         ENDIF         ENDIF
832         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
833         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
834              ok_cvl              ok_cvl
835    
836         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
837         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
838    
839            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
840    
841            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
842            DO i = 1, klon            DO i = 1, klon
# Line 925  contains Line 848  contains
848         ENDIF         ENDIF
849    
850         IF (ok_orodr) THEN         IF (ok_orodr) THEN
851            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
852            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
853           else
854              rugoro = 0.
855         ENDIF         ENDIF
856    
857         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
858         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
859    
860         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
861         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
862         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
863         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
864         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
865    
866         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
867    
868         npas = 0         npas = 0
869         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  
870    
871         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
872    
873         !   Initialisation des sorties         !   Initialisation des sorties
874    
875         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
876         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nq)
877         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
878         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
879         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
880         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
881      ENDIF test_debut      ENDIF test_firstcal
882    
883      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
884    
# Line 985  contains Line 899  contains
899            ENDDO            ENDDO
900         ENDDO         ENDDO
901      ENDDO      ENDDO
902      da(:, :)=0.      da=0.
903      mp(:, :)=0.      mp=0.
904      phi(:, :, :)=0.      phi(:, :, :)=0.
905    
906      ! 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 1018  contains Line 932  contains
932    
933      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
934         ztit='after dynamic'         ztit='after dynamic'
935         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
936              , 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 &
937              , 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)
938         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
939         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1037  contains Line 951  contains
951      IF (ancien_ok) THEN      IF (ancien_ok) THEN
952         DO k = 1, llm         DO k = 1, llm
953            DO i = 1, klon            DO i = 1, klon
954               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
955               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
956            ENDDO            ENDDO
957         ENDDO         ENDDO
958      ELSE      ELSE
# Line 1065  contains Line 979  contains
979    
980      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
981    
982      itap   = itap + 1      itap = itap + 1
983      julien = MOD(NINT(xjour), 360)      julien = MOD(NINT(rdayvrai), 360)
984      if (julien == 0) julien = 360      if (julien == 0) julien = 360
985    
986        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
987    
988      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
989      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
990    
991      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nq >= 5) then
992           wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
993        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
994         CALL ozonecm(REAL(julien), rlat, paprs, wo)         CALL ozonecm(REAL(julien), rlat, paprs, wo)
995      ENDIF      ENDIF
996    
# Line 1094  contains Line 1012  contains
1012    
1013      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1014         ztit='after reevap'         ztit='after reevap'
1015         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
1016              , 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 &
1017              , 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)
1018         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1019              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1125  contains Line 1043  contains
1043    
1044      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1045      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1046         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1047         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1048      ELSE      ELSE
1049         rmu0 = -999.999         rmu0 = -999.999
# Line 1154  contains Line 1072  contains
1072    
1073      fder = dlw      fder = dlw
1074    
1075      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1076           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1077           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1078           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1164  contains Line 1082  contains
1082           fluxlat, rain_fall, snow_fall, &           fluxlat, rain_fall, snow_fall, &
1083           fsolsw, fsollw, sollwdown, fder, &           fsolsw, fsollw, sollwdown, fder, &
1084           rlon, rlat, cuphy, cvphy, frugs, &           rlon, rlat, cuphy, cvphy, frugs, &
1085           debut, lafin, agesno, rugoro, &           firstcal, lafin, agesno, rugoro, &
1086           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
1087           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
1088           q2, dsens, devap, &           q2, dsens, devap, &
# Line 1211  contains Line 1129  contains
1129    
1130      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1131         ztit='after clmain'         ztit='after clmain'
1132         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1133              , 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 &
1134              , 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)
1135         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1136              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1282  contains Line 1200  contains
1200    
1201      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1202         DO i = 1, klon         DO i = 1, klon
1203            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
1204    
1205            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
1206            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
1207            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
1208            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
1209            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
1210            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf)  <  epsfra)  &
1211                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1212            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
1213            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
1214            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
1215            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1216            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1217            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
1218            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
1219            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
1220            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
1221            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
1222         ENDDO         ENDDO
1223      ENDDO      ENDDO
1224    
# Line 1315  contains Line 1233  contains
1233      DO k = 1, llm      DO k = 1, llm
1234         DO i = 1, klon         DO i = 1, klon
1235            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1236                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1237            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1238                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1239         ENDDO         ENDDO
1240      ENDDO      ENDDO
1241      IF (check) THEN      IF (check) THEN
1242         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1243         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1244      ENDIF      ENDIF
1245      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1246      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1333  contains Line 1251  contains
1251         DO k = 1, llm         DO k = 1, llm
1252            DO i = 1, klon            DO i = 1, klon
1253               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)) &
1254                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1255            ENDDO            ENDDO
1256         ENDDO         ENDDO
1257      ENDIF      ENDIF
1258      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1259         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1260      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1261         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1262              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1263              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1264              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1361  contains Line 1279  contains
1279         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1280    
1281         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1282              CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
           CALL concvl (iflag_con, &  
                dtime, paprs, pplay, t_seri, q_seri, &  
1283                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1284                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1285                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1375  contains Line 1291  contains
1291                 da, phi, mp)                 da, phi, mp)
1292    
1293            clwcon0=qcondc            clwcon0=qcondc
1294            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1295         ELSE ! ok_cvl         ELSE ! ok_cvl
1296            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1297            CALL conema3 (dtime, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1298                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1299                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1300                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1390  contains Line 1304  contains
1304                 pbase &                 pbase &
1305                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1306                 , clwcon0)                 , clwcon0)
   
1307         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1308    
1309         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1411  contains Line 1324  contains
1324                  zcor   = 1./(1.-retv*zx_qs)                  zcor   = 1./(1.-retv*zx_qs)
1325                  zx_qs  = zx_qs*zcor                  zx_qs  = zx_qs*zcor
1326               ELSE               ELSE
1327                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1328                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/pplay(i, k)
1329                  ELSE                  ELSE
1330                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1422  contains Line 1335  contains
1335         ENDDO         ENDDO
1336    
1337         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1338         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1339         call clouds_gno &         call clouds_gno &
1340              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1341      ELSE      ELSE
1342         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1343         stop 1         stop 1
1344      ENDIF      ENDIF
1345    
# Line 1441  contains Line 1354  contains
1354    
1355      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1356         ztit='after convect'         ztit='after convect'
1357         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1358              , 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 &
1359              , 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)
1360         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1361              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1453  contains Line 1366  contains
1366    
1367      IF (check) THEN      IF (check) THEN
1368         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1369         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1370         zx_t = 0.0         zx_t = 0.0
1371         za = 0.0         za = 0.0
1372         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1374  contains
1374            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1375                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1376         ENDDO         ENDDO
1377         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1378         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1379      ENDIF      ENDIF
1380      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1381         DO i = 1, klon         DO i = 1, klon
# Line 1471  contains Line 1384  contains
1384         DO k = 1, llm         DO k = 1, llm
1385            DO i = 1, klon            DO i = 1, klon
1386               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)) &
1387                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1388            ENDDO            ENDDO
1389         ENDDO         ENDDO
1390         DO i = 1, klon         DO i = 1, klon
1391            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) &
1392                 /z_apres(i)                 /z_apres(i)
1393         ENDDO         ENDDO
1394         DO k = 1, llm         DO k = 1, llm
1395            DO i = 1, klon            DO i = 1, klon
1396               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
1397                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1398                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1399               ENDIF               ENDIF
1400            ENDDO            ENDDO
# Line 1491  contains Line 1404  contains
1404    
1405      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1406    
1407      d_t_ajs(:, :)=0.      d_t_ajs=0.
1408      d_u_ajs(:, :)=0.      d_u_ajs=0.
1409      d_v_ajs(:, :)=0.      d_v_ajs=0.
1410      d_q_ajs(:, :)=0.      d_q_ajs=0.
1411      fm_therm(:, :)=0.      fm_therm=0.
1412      entr_therm(:, :)=0.      entr_therm=0.
1413    
1414      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1415           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1416           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1417      if(iflag_thermals.lt.0) then      if(iflag_thermals < 0) then
1418         !  Rien         !  Rien
1419         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1420      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1421         !  Ajustement sec         !  Ajustement sec
1422         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1423         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)
1424         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1425         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1426      else      else
1427         !  Thermiques         !  Thermiques
1428         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1429              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1430         call calltherm(pdtphys &         call calltherm(pdtphys &
1431              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1523  contains Line 1436  contains
1436    
1437      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1438         ztit='after dry_adjust'         ztit='after dry_adjust'
1439         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1440              , 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 &
1441              , 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)
1442      END IF      END IF
1443    
# Line 1560  contains Line 1473  contains
1473         !   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
1474         !   relaxation des ratqs         !   relaxation des ratqs
1475         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1476         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1477         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1478      else      else
1479         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1480         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1481      endif      endif
1482    
1483      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1484      ! et le processus de precipitation      ! et le processus de precipitation
1485      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1486           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1487           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1488           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1590  contains Line 1503  contains
1503      ENDDO      ENDDO
1504      IF (check) THEN      IF (check) THEN
1505         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1506         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1507         zx_t = 0.0         zx_t = 0.0
1508         za = 0.0         za = 0.0
1509         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1511  contains
1511            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1512                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1513         ENDDO         ENDDO
1514         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1515         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1516      ENDIF      ENDIF
1517    
1518      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1519         ztit='after fisrt'         ztit='after fisrt'
1520         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1521              , 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 &
1522              , 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)
1523         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1524              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1626  contains Line 1539  contains
1539            rain_tiedtke=0.            rain_tiedtke=0.
1540            do k=1, llm            do k=1, llm
1541               do i=1, klon               do i=1, klon
1542                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1543                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1544                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1545                  endif                  endif
1546               enddo               enddo
1547            enddo            enddo
# Line 1648  contains Line 1561  contains
1561         ENDDO         ENDDO
1562    
1563      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1564         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1565         !  convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1566         !  facttemps         ! facttemps
1567         facteur = pdtphys *facttemps         facteur = pdtphys *facttemps
1568         do k=1, llm         do k=1, llm
1569            do i=1, klon            do i=1, klon
# Line 1664  contains Line 1577  contains
1577         enddo         enddo
1578    
1579         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1580         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1581         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1582    
1583      ENDIF      ENDIF
1584    
# Line 1692  contains Line 1605  contains
1605    
1606      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1607         ztit="after diagcld"         ztit="after diagcld"
1608         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1609              , 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 &
1610              , 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)
1611      END IF      END IF
1612    
# Line 1709  contains Line 1622  contains
1622               zcor   = 1./(1.-retv*zx_qs)               zcor   = 1./(1.-retv*zx_qs)
1623               zx_qs  = zx_qs*zcor               zx_qs  = zx_qs*zcor
1624            ELSE            ELSE
1625               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1626                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/pplay(i, k)
1627               ELSE               ELSE
1628                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1723  contains Line 1636  contains
1636      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1637      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1638         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1639         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1640         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1641    
1642         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1643         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
# Line 1796  contains Line 1709  contains
1709      DO k = 1, llm      DO k = 1, llm
1710         DO i = 1, klon         DO i = 1, klon
1711            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1712                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1713         ENDDO         ENDDO
1714      ENDDO      ENDDO
1715    
1716      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1717         ztit='after rad'         ztit='after rad'
1718         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1719              , 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 &
1720              , 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)
1721         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1722              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1831  contains Line 1744  contains
1744         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1745      ENDDO      ENDDO
1746    
1747      !moddeblott(jan95)      !mod deb lott(jan95)
1748      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1749      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1750    
1751      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1752         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1753         igwd=0         igwd=0
1754         DO i=1, klon         DO i=1, klon
# Line 1848  contains Line 1760  contains
1760            ENDIF            ENDIF
1761         ENDDO         ENDDO
1762    
1763         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1764              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1765              igwd, idx, itest, &              igwd, idx, itest, &
1766              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1863  contains Line 1775  contains
1775               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)
1776            ENDDO            ENDDO
1777         ENDDO         ENDDO
1778        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1779    
1780      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1781    
# Line 1879  contains Line 1790  contains
1790            ENDIF            ENDIF
1791         ENDDO         ENDDO
1792    
1793         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1794              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1795              itest, &              itest, &
1796              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1905  contains Line 1816  contains
1816      ENDDO      ENDDO
1817      DO k = 1, llm      DO k = 1, llm
1818         DO i = 1, klon         DO i = 1, klon
1819            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)
1820                 (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  
1821         ENDDO         ENDDO
1822      ENDDO      ENDDO
1823    
1824      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1825    
1826      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1827           ra, rg, romega, &           ra, rg, romega, &
1828           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1829           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1924  contains Line 1833  contains
1833    
1834      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1835         ztit='after orography'         ztit='after orography'
1836         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1837              , 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 &
1838              , 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)
1839      END IF      END IF
1840    
# Line 1933  contains Line 1842  contains
1842    
1843      !   Calcul  des tendances traceurs      !   Calcul  des tendances traceurs
1844    
1845      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1846           dtime, u, v, t, paprs, pplay, &           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1847           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1848           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           frac_impa,  frac_nucl, pphis, pphi, albsol, rhcl, cldfra, &
1849           pctsrf, frac_impa,  frac_nucl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1850           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)  
1851    
1852      IF (offline) THEN      IF (offline) THEN
1853    
# Line 1952  contains Line 1857  contains
1857              fm_therm, entr_therm, &              fm_therm, entr_therm, &
1858              ycoefh, yu1, yv1, ftsol, pctsrf, &              ycoefh, yu1, yv1, ftsol, pctsrf, &
1859              frac_impa, frac_nucl, &              frac_impa, frac_nucl, &
1860              pphis, airephy, dtime, itap)              pphis, airephy, pdtphys, itap)
1861    
1862      ENDIF      ENDIF
1863    
# Line 1977  contains Line 1882  contains
1882            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1883                 *(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)
1884            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)
1885            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1886         END DO         END DO
1887      END DO      END DO
1888      !-jld ec_conser      !-jld ec_conser
1889      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1890         ztit='after physic'         ztit='after physic'
1891         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1892              , 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 &
1893              , 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)
1894         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1895         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 2002  contains Line 1907  contains
1907    
1908      !   SORTIES      !   SORTIES
1909    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1910      !cc prw = eau precipitable      !cc prw = eau precipitable
1911      DO i = 1, klon      DO i = 1, klon
1912         prw(i) = 0.         prw(i) = 0.
1913         DO k = 1, llm         DO k = 1, llm
1914            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  
1915         ENDDO         ENDDO
1916      ENDDO      ENDDO
1917    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1918      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1919    
1920      DO k = 1, llm      DO k = 1, llm
1921         DO i = 1, klon         DO i = 1, klon
1922            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1923            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1924            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1925            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
1926            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
1927         ENDDO         ENDDO
1928      ENDDO      ENDDO
1929    
# Line 2033  contains Line 1931  contains
1931         DO iq = 3, nq         DO iq = 3, nq
1932            DO  k = 1, llm            DO  k = 1, llm
1933               DO  i = 1, klon               DO  i = 1, klon
1934                  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
1935               ENDDO               ENDDO
1936            ENDDO            ENDDO
1937         ENDDO         ENDDO
1938      ENDIF      ENDIF
1939    
1940      ! 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:
   
1941      DO k = 1, llm      DO k = 1, llm
1942         DO i = 1, klon         DO i = 1, klon
1943            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 2049  contains Line 1946  contains
1946      ENDDO      ENDDO
1947    
1948      !   Ecriture des sorties      !   Ecriture des sorties
   
1949      call write_histhf      call write_histhf
1950      call write_histday      call write_histday
1951      call write_histins      call write_histins
1952    
1953      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1954      IF (lafin) THEN      IF (lafin) THEN
1955         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1956         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
1957              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
1958              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1959              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
1960              radsol, frugs, agesno, &              radsol, frugs, agesno, &
1961              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1962              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1963      ENDIF      ENDIF
1964    
1965    contains    contains
1966    
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la physique ou  
       !IM toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
   
       ! initialisations diverses au "debut" du mois  
   
       IF(MOD(itap, ecrit_mth) == 1) THEN  
          DO i=1, klon  
             nday_rain(i)=0.  
          ENDDO  
       ENDIF  
   
       IF(MOD(itap, ecrit_day) == 0) THEN  
          !IM calcul total_rain, nday_rain  
          DO i = 1, klon  
             total_rain(i)=rain_fall(i)+snow_fall(i)    
             IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.  
          ENDDO  
       ENDIF  
   
     End SUBROUTINE calcul_divers  
   
     !***********************************************  
   
1967      subroutine write_histday      subroutine write_histday
1968    
1969        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use grid_change, only: gr_phy_write_3d
1970          integer itau_w  ! pas de temps ecriture
       if (ok_journe) THEN  
   
          ndex2d = 0  
          ndex3d = 0  
1971    
1972           ! Champs 2D:        !------------------------------------------------
1973    
1974          if (ok_journe) THEN
1975           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1976             if (nq <= 4) then
1977           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1978                     gr_phy_write_3d(wo) * 1e3)
1979                ! (convert "wo" from kDU to DU)
1980             end if
1981           if (ok_sync) then           if (ok_sync) then
1982              call histsync(nid_day)              call histsync(nid_day)
1983           endif           endif
   
1984        ENDIF        ENDIF
1985    
1986      End subroutine write_histday      End subroutine write_histday
# Line 2454  contains Line 1991  contains
1991    
1992        ! 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
1993    
1994        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1995    
1996        call write_histhf3d        call write_histhf3d
1997    
# Line 2474  contains Line 2008  contains
2008        ! 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
2009    
2010        real zout        real zout
2011          integer itau_w  ! pas de temps ecriture
2012    
2013        !--------------------------------------------------        !--------------------------------------------------
2014    
2015        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
2016           ! Champs 2D:           ! Champs 2D:
2017    
2018           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
2019           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
2020           itau_w = itau_phy + itap           itau_w = itau_phy + itap
2021    
2022           i = NINT(zout/zsto)           i = NINT(zout/zsto)
2023           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)
2024           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
2025    
2026           i = NINT(zout/zsto)           i = NINT(zout/zsto)
2027           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)
2028           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
2029    
2030           DO i = 1, klon           DO i = 1, klon
2031              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
2032           ENDDO           ENDDO
2033           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)
2034           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
2035    
2036           DO i = 1, klon           DO i = 1, klon
2037              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2038           ENDDO           ENDDO
2039           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)
2040           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
2041    
2042           DO i = 1, klon           DO i = 1, klon
2043              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2044           ENDDO           ENDDO
2045           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)
2046           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
2047    
2048           DO i = 1, klon           DO i = 1, klon
2049              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2050           ENDDO           ENDDO
2051           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)
2052           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2053    
2054           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)
2055           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2056           !ccIM           !ccIM
2057           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)
2058           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2059    
2060           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)
2061           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2062    
2063           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)
2064           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2065    
2066           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)
2067           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2068    
2069           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)
2070           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2071    
2072           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)
2073           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2074    
2075           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)
2076           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2077    
2078           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)
2079           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2080    
2081           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)
2082           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2083    
2084           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)
2085           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2086    
2087           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)
2088           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2089    
2090           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)
2091           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2092    
2093           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)
2094           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2095    
2096           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2097           !     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)
2098           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)
2099           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2100    
2101           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)
2102           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2103    
2104           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)
2105           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2106    
2107           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)
2108           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2109    
2110           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)
2111           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2112    
2113           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)
2114           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2115    
2116           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2117              !XXX              !XXX
2118              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2119              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)
2120              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2121                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2122    
2123              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2124              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)
2125              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2126                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2127    
2128              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2129              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)
2130              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2131                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2132    
2133              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2134              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)
2135              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2136                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2137    
2138              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2139              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)
2140              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2141                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2142    
2143              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2144              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)
2145              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2146                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2147    
2148              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2149              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)
2150              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2151                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2152    
2153              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2154              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)
2155              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2156                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2157    
2158              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2159              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)
2160              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2161                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2162    
2163           END DO           END DO
2164           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)
2165           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2166           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)
2167           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2168    
2169           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)
2170           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2171    
2172           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2173    
2174           !HBTM2           !HBTM2
2175    
2176           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)
2177           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)
2178    
2179           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)
2180           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)
2181    
2182           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)
2183           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)
2184    
2185           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)
2186           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)  
2187    
2188           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)
2189           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)  
2190    
2191           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)
2192           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)  
2193    
2194           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)
2195           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)  
2196    
2197           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)
2198           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)  
2199    
2200           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)
2201           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)  
2202    
2203           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)
2204           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)  
2205    
2206           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2207    
2208           ! Champs 3D:           ! Champs 3D:
2209    
2210           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)
2211           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)  
2212    
2213           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)
2214           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)  
2215    
2216           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)
2217           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)  
2218    
2219           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)
2220           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)  
2221    
2222           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)
2223           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)  
2224    
2225           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)
2226           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)  
2227    
2228           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)
2229           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)  
2230    
2231           if (ok_sync) then           if (ok_sync) then
2232              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2729  contains Line 2241  contains
2241    
2242        ! 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
2243    
2244        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2245        ndex3d = 0  
2246          !-------------------------------------------------------
2247    
2248        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2249    
2250        ! Champs 3D:        ! Champs 3D:
2251    
2252        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)
2253        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)  
2254    
2255        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)
2256        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)  
2257    
2258        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)
2259        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)  
2260    
2261        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)
2262        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)  
2263    
2264        if (nbtr >= 3) then        if (nbtr >= 3) then
2265           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), &
2266                zx_tmp_3d)                zx_tmp_3d)
2267           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)  
2268        end if        end if
2269    
2270        if (ok_sync) then        if (ok_sync) then
# Line 2767  contains Line 2275  contains
2275    
2276    END SUBROUTINE physiq    END SUBROUTINE physiq
2277    
   !****************************************************  
   
   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  
   
2278  end module physiq_m  end module physiq_m
Legend:
Removed from v.6  
changed lines
  Added in v.20
  ViewVC Help
Powered by ViewVC 1.1.21