/[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 13 by guez, Fri Jul 25 19:59:34 2008 UTC revision 35 by guez, Tue Jun 8 15:37:21 2010 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, 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, version 1.22 2006/02/20 09:38:28
17    
18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18      ! Author : Z.X. Li (LMD/CNRS), date: 1993/08/18
19    
# Line 23  contains Line 23  contains
23      !AA                  -  stockage des moyennes des champs necessaires      !AA                  -  stockage des moyennes des champs necessaires
24      !AA                     en mode traceur off-line      !AA                     en mode traceur off-line
25    
26      USE ioipsl, only: ymds2ju, histwrite, histsync      use abort_gcm_m, only: abort_gcm
27      use dimens_m, only: jjm, iim, llm      USE calendar, only: ymds2ju
28      use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
          clnsurf, epsfra  
     use dimphy, only: klon, nbtr  
     use conf_gcm_m, only: raz_date, offline, iphysiq  
     use dimsoil, only: nsoilmx  
     use temps, only: itau_phy, day_ref, annee_ref, itaufin  
     use clesphys, only: ecrit_hf, ecrit_hf2mth, &  
          ecrit_ins, ecrit_mth, ecrit_day, &  
29           cdmmax, cdhmax, &           cdmmax, cdhmax, &
30           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
31           ok_kzmin           ok_kzmin
32      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
33           cycle_diurne, new_oliq, soil_model           cycle_diurne, new_oliq, soil_model
     use iniprint, only: prt_level  
     use abort_gcm_m, only: abort_gcm  
     use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega  
34      use comgeomphy      use comgeomphy
35        use conf_gcm_m, only: raz_date, offline
36        use conf_phys_m, only: conf_phys
37      use ctherm      use ctherm
38      use phytrac_m, only: phytrac      use dimens_m, only: jjm, iim, llm, nqmx
39        use dimphy, only: klon, nbtr
40        use dimsoil, only: nsoilmx
41        use hgardfou_m, only: hgardfou
42        USE histcom, only: histsync
43        USE histwrite_m, only: histwrite
44        use indicesol, only: nbsrf, is_ter, is_lic, is_sic, is_oce, &
45             clnsurf, epsfra
46        use ini_histhf_m, only: ini_histhf
47        use ini_histday_m, only: ini_histday
48        use ini_histins_m, only: ini_histins
49        use iniprint, only: prt_level
50      use oasis_m      use oasis_m
51        use orbite_m, only: orbite, zenang
52        use ozonecm_m, only: ozonecm
53        use phyetat0_m, only: phyetat0, rlat, rlon
54        use phyredem_m, only: phyredem
55        use phystokenc_m, only: phystokenc
56        use phytrac_m, only: phytrac
57        use qcheck_m, only: qcheck
58      use radepsi      use radepsi
59      use radopt      use radopt
60        use temps, only: itau_phy, day_ref, annee_ref
61      use yoethf      use yoethf
62      use ini_hist, only: ini_histhf, ini_histday, ini_histins      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
     use orbite_m, only: orbite, zenang  
     use phyetat0_m, only: phyetat0, rlat, rlon  
     use hgardfou_m, only: hgardfou  
     use conf_phys_m, only: conf_phys  
63    
64      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
65      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
66    
67      ! Variables argument:      ! Variables argument:
68    
69      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      REAL, intent(in):: rdayvrai
70      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience      ! (elapsed time since January 1st 0h of the starting year, in days)
71    
72      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
73      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
     LOGICAL, intent(in):: firstcal ! first call to "calfis"  
74      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
75    
76      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
77      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
78        
79      REAL, intent(in):: pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
80      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
81    
# Line 77  contains Line 84  contains
84    
85      REAL pphis(klon) ! input geopotentiel du sol      REAL pphis(klon) ! input geopotentiel du sol
86    
     REAL presnivs(llm)  
     ! (input pressions approximat. des milieux couches ( en PA))  
   
87      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s      REAL u(klon, llm)  ! input vitesse dans la direction X (de O a E) en m/s
88      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL, intent(in):: v(klon, llm)  ! vitesse Y (de S a N) en m/s
89      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
90    
91      REAL, intent(in):: qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nqmx)
92      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)      ! (humidité spécifique et fractions massiques des autres traceurs)
93    
94      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
95      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
96      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)      REAL d_v(klon, llm)  ! output tendance physique de "v" (m/s/s)
97      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)      REAL d_t(klon, llm)  ! output tendance physique de "t" (K/s)
98      REAL d_qx(klon, llm, nq)  ! output tendance physique de "qx" (kg/kg/s)      REAL d_qx(klon, llm, nqmx)  ! output tendance physique de "qx" (kg/kg/s)
99      REAL d_ps(klon)  ! output tendance physique de la pression au sol      REAL d_ps(klon)  ! output tendance physique de la pression au sol
100    
101        LOGICAL:: firstcal = .true.
102    
103      INTEGER nbteta      INTEGER nbteta
104      PARAMETER(nbteta=3)      PARAMETER(nbteta=3)
105    
# Line 130  contains Line 136  contains
136      REAL fluxg(klon)    !flux turbulents ocean-atmosphere      REAL fluxg(klon)    !flux turbulents ocean-atmosphere
137    
138      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
139      logical ok_veget      logical, save:: ok_veget
140      save ok_veget      LOGICAL, save:: ok_journe ! sortir le fichier journalier
     LOGICAL ok_journe ! sortir le fichier journalier  
     save ok_journe  
141    
142      LOGICAL ok_mensuel ! sortir le fichier mensuel      LOGICAL ok_mensuel ! sortir le fichier mensuel
143    
# Line 180  contains Line 184  contains
184      REAL swup0(klon, klevp1), swup(klon, klevp1)      REAL swup0(klon, klevp1), swup(klon, klevp1)
185      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
186    
     REAL SWdn200clr(klon), SWdn200(klon)  
     REAL SWup200clr(klon), SWup200(klon)  
     SAVE SWdn200clr, SWdn200, SWup200clr, SWup200  
   
187      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)
188      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, klevp1), lwup(klon, klevp1)
189      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
190    
     REAL LWdn200clr(klon), LWdn200(klon)  
     REAL LWup200clr(klon), LWup200(klon)  
     SAVE LWdn200clr, LWdn200, LWup200clr, LWup200  
   
191      !IM Amip2      !IM Amip2
192      ! variables a une pression donnee      ! variables a une pression donnee
193    
# Line 206  contains Line 202  contains
202           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &           '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &
203           '70  ', '50  ', '30  ', '20  ', '10  '/           '70  ', '50  ', '30  ', '20  ', '10  '/
204    
     real tlevSTD(klon, nlevSTD), qlevSTD(klon, nlevSTD)  
     real rhlevSTD(klon, nlevSTD), philevSTD(klon, nlevSTD)  
     real ulevSTD(klon, nlevSTD), vlevSTD(klon, nlevSTD)  
     real wlevSTD(klon, nlevSTD)  
   
     ! nout : niveau de output des variables a une pression donnee  
     INTEGER nout  
     PARAMETER(nout=3) !nout=1 : day; =2 : mth; =3 : NMC  
   
     REAL tsumSTD(klon, nlevSTD, nout)  
     REAL usumSTD(klon, nlevSTD, nout), vsumSTD(klon, nlevSTD, nout)  
     REAL wsumSTD(klon, nlevSTD, nout), phisumSTD(klon, nlevSTD, nout)  
     REAL qsumSTD(klon, nlevSTD, nout), rhsumSTD(klon, nlevSTD, nout)  
   
     SAVE tsumSTD, usumSTD, vsumSTD, wsumSTD, phisumSTD,  &  
          qsumSTD, rhsumSTD  
   
     logical oknondef(klon, nlevSTD, nout)  
     real tnondef(klon, nlevSTD, nout)  
     save tnondef  
   
     ! les produits uvSTD, vqSTD, .., T2STD sont calcules  
     ! a partir des valeurs instantannees toutes les 6 h  
     ! qui sont moyennees sur le mois  
   
     real uvSTD(klon, nlevSTD)  
     real vqSTD(klon, nlevSTD)  
     real vTSTD(klon, nlevSTD)  
     real wqSTD(klon, nlevSTD)  
   
     real uvsumSTD(klon, nlevSTD, nout)  
     real vqsumSTD(klon, nlevSTD, nout)  
     real vTsumSTD(klon, nlevSTD, nout)  
     real wqsumSTD(klon, nlevSTD, nout)  
   
     real vphiSTD(klon, nlevSTD)  
     real wTSTD(klon, nlevSTD)  
     real u2STD(klon, nlevSTD)  
     real v2STD(klon, nlevSTD)  
     real T2STD(klon, nlevSTD)  
   
     real vphisumSTD(klon, nlevSTD, nout)  
     real wTsumSTD(klon, nlevSTD, nout)  
     real u2sumSTD(klon, nlevSTD, nout)  
     real v2sumSTD(klon, nlevSTD, nout)  
     real T2sumSTD(klon, nlevSTD, nout)  
   
     SAVE uvsumSTD, vqsumSTD, vTsumSTD, wqsumSTD  
     SAVE vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, T2sumSTD  
     !MI Amip2  
   
205      ! prw: precipitable water      ! prw: precipitable water
206      real prw(klon)      real prw(klon)
207    
# Line 265  contains Line 210  contains
210      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
211      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
212    
213      INTEGER l, kmax, lmax      INTEGER kmax, lmax
214      PARAMETER(kmax=8, lmax=8)      PARAMETER(kmax=8, lmax=8)
215      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
216      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)      PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1)
# Line 317  contains Line 262  contains
262      integer nid_hf, nid_hf3d      integer nid_hf, nid_hf3d
263      save nid_hf, nid_hf3d      save nid_hf, nid_hf3d
264    
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
   
265      ! Variables propres a la physique      ! Variables propres a la physique
266    
267      INTEGER, save:: radpas      INTEGER, save:: radpas
# Line 425  contains Line 367  contains
367      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
368      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
369    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
370      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
371      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
372      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 459  contains Line 398  contains
398      REAL albsollw(klon)      REAL albsollw(klon)
399      SAVE albsollw                 ! albedo du sol total      SAVE albsollw                 ! albedo du sol total
400    
401      REAL, SAVE:: wo(klon, llm) ! ozone      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
402    
403      ! Declaration des procedures appelees      ! Declaration des procedures appelees
404    
# Line 470  contains Line 409  contains
409      EXTERNAL conema3  ! convect4.3      EXTERNAL conema3  ! convect4.3
410      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
411      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
     EXTERNAL ozonecm   ! prescrire l'ozone  
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
412      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
413      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
414    
     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)  
   
415      ! Variables locales      ! Variables locales
416    
417      real clwcon(klon, llm), rnebcon(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm)
# Line 627  contains Line 559  contains
559      save ratqsbas, ratqshaut, ratqs      save ratqsbas, ratqshaut, ratqs
560    
561      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
562      real fact_cldcon      real, save:: fact_cldcon
563      real facttemps      real, save:: facttemps
564      logical ok_newmicro      logical ok_newmicro
565      save ok_newmicro      save ok_newmicro
     save fact_cldcon, facttemps  
566      real facteur      real facteur
567    
568      integer iflag_cldcon      integer iflag_cldcon
# Line 639  contains Line 570  contains
570    
571      logical ptconv(klon, llm)      logical ptconv(klon, llm)
572    
     ! Variables liees a l'ecriture de la bande histoire physique  
   
     integer itau_w   ! pas de temps ecriture = itap + itau_phy  
   
573      ! Variables locales pour effectuer les appels en serie      ! Variables locales pour effectuer les appels en serie
574    
575      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
# Line 653  contains Line 580  contains
580      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
581    
582      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
     INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)  
583    
584      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
585      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
# Line 663  contains Line 589  contains
589      REAL dudyn(iim+1, jjm + 1, llm)      REAL dudyn(iim+1, jjm + 1, llm)
590    
591      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     REAL zx_tmp_fi3d(klon, llm) ! variable temporaire pour champs 3D  
   
592      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)
593    
594      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
595    
596      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.
597      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 693  contains Line 616  contains
616      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
617      SAVE      ip_ebil      SAVE      ip_ebil
618      DATA      ip_ebil/0/      DATA      ip_ebil/0/
619      INTEGER   if_ebil ! level for energy conserv. dignostics      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics
     SAVE      if_ebil  
620      !+jld ec_conser      !+jld ec_conser
621      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
622      REAL ZRCPD      REAL ZRCPD
# Line 766  contains Line 688  contains
688      SAVE trmb2      SAVE trmb2
689      SAVE trmb3      SAVE trmb3
690    
691        real zmasse(klon, llm)
692        ! (column-density of mass of air in a cell, in kg m-2)
693    
694        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
695    
696      !----------------------------------------------------------------      !----------------------------------------------------------------
697    
698      modname = 'physiq'      modname = 'physiq'
# Line 775  contains Line 702  contains
702         END DO         END DO
703      END IF      END IF
704      ok_sync=.TRUE.      ok_sync=.TRUE.
705      IF (nq  <  2) THEN      IF (nqmx  <  2) THEN
706         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
707         CALL abort_gcm(modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
708      ENDIF      ENDIF
# Line 848  contains Line 775  contains
775         radpas = NINT( 86400. / pdtphys / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
776    
777         ! on remet le calendrier a zero         ! on remet le calendrier a zero
778           IF (raz_date) itau_phy = 0
        IF (raz_date == 1) THEN  
           itau_phy = 0  
        ENDIF  
779    
780         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
781    
# Line 898  contains Line 822  contains
822    
823         ecrit_ins = NINT(ecrit_ins/pdtphys)         ecrit_ins = NINT(ecrit_ins/pdtphys)
824         ecrit_hf = NINT(ecrit_hf/pdtphys)         ecrit_hf = NINT(ecrit_hf/pdtphys)
        ecrit_day = NINT(ecrit_day/pdtphys)  
825         ecrit_mth = NINT(ecrit_mth/pdtphys)         ecrit_mth = NINT(ecrit_mth/pdtphys)
826         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
827         ecrit_reg = NINT(ecrit_reg/pdtphys)         ecrit_reg = NINT(ecrit_reg/pdtphys)
# Line 912  contains Line 835  contains
835    
836         !   Initialisation des sorties         !   Initialisation des sorties
837    
838         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, nid_hf, nid_hf3d)
839         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, ok_journe, nid_day, nqmx)
840         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, ok_instan, nid_ins)
841         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
842         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
843         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
# Line 932  contains Line 855  contains
855            d_v(i, k) = 0.0            d_v(i, k) = 0.0
856         ENDDO         ENDDO
857      ENDDO      ENDDO
858      DO iq = 1, nq      DO iq = 1, nqmx
859         DO k = 1, llm         DO k = 1, llm
860            DO i = 1, klon            DO i = 1, klon
861               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.0
# Line 955  contains Line 878  contains
878            qs_seri(i, k) = 0.            qs_seri(i, k) = 0.
879         ENDDO         ENDDO
880      ENDDO      ENDDO
881      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
882         tr_seri(:, :, :nq-2) = qx(:, :, 3:nq)         tr_seri(:, :, :nqmx-2) = qx(:, :, 3:nqmx)
883      ELSE      ELSE
884         tr_seri(:, :, 1) = 0.         tr_seri(:, :, 1) = 0.
885      ENDIF      ENDIF
# Line 1023  contains Line 946  contains
946      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(NINT(rdayvrai), 360)
947      if (julien == 0) julien = 360      if (julien == 0) julien = 360
948    
949        forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
950    
951      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
952      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
953    
954      IF (MOD(itap - 1, lmt_pas) == 0) THEN      if (nqmx >= 5) then
955         CALL ozonecm(REAL(julien), rlat, paprs, wo)         wo = qx(:, :, 5) * zmasse / dobson_u / 1e3
956        else IF (MOD(itap - 1, lmt_pas) == 0) THEN
957           wo = ozonecm(REAL(julien), paprs)
958      ENDIF      ENDIF
959    
960      ! Re-evaporer l'eau liquide nuageuse      ! Re-evaporer l'eau liquide nuageuse
# Line 1287  contains Line 1214  contains
1214         DO k = 1, llm         DO k = 1, llm
1215            DO i = 1, klon            DO i = 1, klon
1216               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)) &
1217                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1218            ENDDO            ENDDO
1219         ENDDO         ENDDO
1220      ENDIF      ENDIF
# Line 1315  contains Line 1242  contains
1242         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1243    
1244         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
1245            CALL concvl (iflag_con, &            CALL concvl(iflag_con, pdtphys, paprs, pplay, t_seri, q_seri, &
                pdtphys, paprs, pplay, t_seri, q_seri, &  
1246                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1247                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1248                 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 1331  contains Line 1257  contains
1257            pmfu=upwd+dnwd            pmfu=upwd+dnwd
1258         ELSE ! ok_cvl         ELSE ! ok_cvl
1259            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1260            CALL conema3 (pdtphys, &            CALL conema3 (pdtphys, paprs, pplay, t_seri, q_seri, &
                paprs, pplay, t_seri, q_seri, &  
1261                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1262                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1263                 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 1422  contains Line 1347  contains
1347         DO k = 1, llm         DO k = 1, llm
1348            DO i = 1, klon            DO i = 1, klon
1349               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)) &
1350                    *(paprs(i, k)-paprs(i, k+1))/RG                    *zmasse(i, k)
1351            ENDDO            ENDDO
1352         ENDDO         ENDDO
1353         DO i = 1, klon         DO i = 1, klon
# Line 1579  contains Line 1504  contains
1504               do i=1, klon               do i=1, klon
1505                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1506                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1507                          *(paprs(i, k)-paprs(i, k+1))/rg                          *zmasse(i, k)
1508                  endif                  endif
1509               enddo               enddo
1510            enddo            enddo
# Line 1854  contains Line 1779  contains
1779      ENDDO      ENDDO
1780      DO k = 1, llm      DO k = 1, llm
1781         DO i = 1, klon         DO i = 1, klon
1782            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* zmasse(i, k)
1783                 (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))/pdtphys* &  
                (paprs(i, k)-paprs(i, k+1))/rg  
1784         ENDDO         ENDDO
1785      ENDDO      ENDDO
1786    
1787      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1788    
1789      CALL aaam_bud (27, klon, llm, gmtime, &      CALL aaam_bud(27, klon, llm, gmtime, &
1790           ra, rg, romega, &           ra, rg, romega, &
1791           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1792           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1878  contains Line 1801  contains
1801              , 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)
1802      END IF      END IF
1803    
1804      !AA Installation de l'interface online-offline pour traceurs      ! Calcul  des tendances traceurs
1805        call phytrac(rnpb, itap, lmt_pas, julien, gmtime, firstcal, lafin, &
1806      !   Calcul  des tendances traceurs           nqmx-2, pdtphys, u, t, paprs, pplay, pmfu, pmfd, pen_u, pde_u, &
1807             pen_d, pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1808      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &           frac_impa, frac_nucl, pphis, pphi, albsol, rhcl, cldfra, rneb, &
1809           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &           diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, &
1810           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &           tr_seri, zmasse)
          frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &  
          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &  
          psfl, da, phi, mp, upwd, dnwd, tr_seri)  
1811    
1812      IF (offline) THEN      IF (offline) THEN
1813           call phystokenc(pdtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &
1814         print*, 'Attention on met a 0 les thermiques pour phystoke'              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1815         call phystokenc(pdtphys, rlon, rlat, &              pctsrf, frac_impa, frac_nucl, pphis, airephy, pdtphys, itap)
             t, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
             fm_therm, entr_therm, &  
             ycoefh, yu1, yv1, ftsol, pctsrf, &  
             frac_impa, frac_nucl, &  
             pphis, airephy, pdtphys, itap)  
   
1816      ENDIF      ENDIF
1817    
1818      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1819        CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
1820             ue, uq)
1821    
1822      CALL transp (paprs, zxtsol, &      ! diag. bilKP
          t_seri, q_seri, u_seri, v_seri, zphi, &  
          ve, vq, ue, uq)  
   
     !IM diag. bilKP  
1823    
1824      CALL transp_lay (paprs, zxtsol, &      CALL transp_lay (paprs, zxtsol, &
1825           t_seri, q_seri, u_seri, v_seri, zphi, &           t_seri, q_seri, u_seri, v_seri, zphi, &
# Line 1947  contains Line 1859  contains
1859    
1860      !   SORTIES      !   SORTIES
1861    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1862      !cc prw = eau precipitable      !cc prw = eau precipitable
1863      DO i = 1, klon      DO i = 1, klon
1864         prw(i) = 0.         prw(i) = 0.
1865         DO k = 1, llm         DO k = 1, llm
1866            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  
1867         ENDDO         ENDDO
1868      ENDDO      ENDDO
1869    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1870      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1871    
1872      DO k = 1, llm      DO k = 1, llm
# Line 1974  contains Line 1879  contains
1879         ENDDO         ENDDO
1880      ENDDO      ENDDO
1881    
1882      IF (nq >= 3) THEN      IF (nqmx >= 3) THEN
1883         DO iq = 3, nq         DO iq = 3, nqmx
1884            DO  k = 1, llm            DO  k = 1, llm
1885               DO  i = 1, klon               DO  i = 1, klon
1886                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
# Line 1985  contains Line 1890  contains
1890      ENDIF      ENDIF
1891    
1892      ! 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:
   
1893      DO k = 1, llm      DO k = 1, llm
1894         DO i = 1, klon         DO i = 1, klon
1895            t_ancien(i, k) = t_seri(i, k)            t_ancien(i, k) = t_seri(i, k)
# Line 1994  contains Line 1898  contains
1898      ENDDO      ENDDO
1899    
1900      !   Ecriture des sorties      !   Ecriture des sorties
   
1901      call write_histhf      call write_histhf
1902      call write_histday      call write_histday
1903      call write_histins      call write_histins
1904    
1905      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
   
1906      IF (lafin) THEN      IF (lafin) THEN
1907         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1908         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
# Line 2012  contains Line 1914  contains
1914              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
1915      ENDIF      ENDIF
1916    
1917    contains      firstcal = .FALSE.
   
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la  
       ! physique ou toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
1918    
1919        ! initialisations diverses au "debut" du mois    contains
   
       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  
   
     !***********************************************  
1920    
1921      subroutine write_histday      subroutine write_histday
1922    
1923        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use gr_phy_write_3d_m, only: gr_phy_write_3d
1924          integer itau_w  ! pas de temps ecriture
       if (ok_journe) THEN  
   
          ndex2d = 0  
          ndex3d = 0  
1925    
1926           ! Champs 2D:        !------------------------------------------------
1927    
1928          if (ok_journe) THEN
1929           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1930             if (nqmx <= 4) then
1931           !   FIN ECRITURE DES CHAMPS 3D              call histwrite(nid_day, "Sigma_O3_Royer", itau_w, &
1932                     gr_phy_write_3d(wo) * 1e3)
1933                ! (convert "wo" from kDU to DU)
1934             end if
1935           if (ok_sync) then           if (ok_sync) then
1936              call histsync(nid_day)              call histsync(nid_day)
1937           endif           endif
   
1938        ENDIF        ENDIF
1939    
1940      End subroutine write_histday      End subroutine write_histday
# Line 2397  contains Line 1945  contains
1945    
1946        ! 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
1947    
1948        ndex2d = 0        !------------------------------------------------
       ndex3d = 0  
   
       itau_w = itau_phy + itap  
1949    
1950        call write_histhf3d        call write_histhf3d
1951    
# Line 2417  contains Line 1962  contains
1962        ! 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
1963    
1964        real zout        real zout
1965          integer itau_w  ! pas de temps ecriture
1966    
1967        !--------------------------------------------------        !--------------------------------------------------
1968    
1969        IF (ok_instan) THEN        IF (ok_instan) THEN
   
          ndex2d = 0  
          ndex3d = 0  
   
1970           ! Champs 2D:           ! Champs 2D:
1971    
1972           zsto = pdtphys * ecrit_ins           zsto = pdtphys * ecrit_ins
# Line 2433  contains Line 1975  contains
1975    
1976           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1977           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)
1978           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1979    
1980           i = NINT(zout/zsto)           i = NINT(zout/zsto)
1981           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)
1982           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1983    
1984           DO i = 1, klon           DO i = 1, klon
1985              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
1986           ENDDO           ENDDO
1987           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)
1988           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
1989    
1990           DO i = 1, klon           DO i = 1, klon
1991              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
1992           ENDDO           ENDDO
1993           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)
1994           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
1995    
1996           DO i = 1, klon           DO i = 1, klon
1997              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
1998           ENDDO           ENDDO
1999           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)
2000           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
2001    
2002           DO i = 1, klon           DO i = 1, klon
2003              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2004           ENDDO           ENDDO
2005           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)
2006           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2007    
2008           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)
2009           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2010           !ccIM           !ccIM
2011           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)
2012           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2013    
2014           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)
2015           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2016    
2017           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)
2018           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2019    
2020           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)
2021           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2022    
2023           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)
2024           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2025    
2026           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)
2027           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2028    
2029           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)
2030           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2031    
2032           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)
2033           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2034    
2035           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)
2036           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2037    
2038           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)
2039           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2040    
2041           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)
2042           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2043    
2044           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)
2045           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2046    
2047           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)
2048           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2049    
2050           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2051           !     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)
2052           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)
2053           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2054    
2055           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)
2056           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2057    
2058           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)
2059           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2060    
2061           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)
2062           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2063    
2064           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)
2065           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2066    
2067           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)
2068           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2069    
2070           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2071              !XXX              !XXX
2072              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2073              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)
2074              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2075                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2076    
2077              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2078              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)
2079              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2080                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2081    
2082              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2083              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)
2084              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2085                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2086    
2087              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2088              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)
2089              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2090                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2091    
2092              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2093              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)
2094              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2095                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2096    
2097              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
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, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2100                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2101    
2102              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2103              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)
2104              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2105                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2106    
2107              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2108              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)
2109              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2110                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2111    
2112              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2113              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)
2114              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2115                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2116    
2117           END DO           END DO
2118           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)
2119           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2120           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)
2121           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2122    
2123           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)
2124           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2125    
2126           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2127    
2128           !HBTM2           !HBTM2
2129    
2130           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)
2131           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)
2132    
2133           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)
2134           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)
2135    
2136           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)
2137           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)
2138    
2139           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)
2140           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)  
2141    
2142           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)
2143           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)  
2144    
2145           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)
2146           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)  
2147    
2148           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)
2149           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)  
2150    
2151           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)
2152           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)  
2153    
2154           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)
2155           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)  
2156    
2157           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)
2158           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)  
2159    
2160           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2161    
2162           ! Champs 3D:           ! Champs 3D:
2163    
2164           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)
2165           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)  
2166    
2167           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)
2168           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)  
2169    
2170           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)
2171           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)  
2172    
2173           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)
2174           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)  
2175    
2176           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)
2177           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)  
2178    
2179           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)
2180           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)  
2181    
2182           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)
2183           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)  
2184    
2185           if (ok_sync) then           if (ok_sync) then
2186              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2672  contains Line 2195  contains
2195    
2196        ! 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
2197    
2198        ndex2d = 0        integer itau_w  ! pas de temps ecriture
2199        ndex3d = 0  
2200          !-------------------------------------------------------
2201    
2202        itau_w = itau_phy + itap        itau_w = itau_phy + itap
2203    
2204        ! Champs 3D:        ! Champs 3D:
2205    
2206        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)
2207        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)  
2208    
2209        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)
2210        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)  
2211    
2212        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)
2213        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)  
2214    
2215        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)
2216        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)  
2217    
2218        if (nbtr >= 3) then        if (nbtr >= 3) then
2219           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), &
2220                zx_tmp_3d)                zx_tmp_3d)
2221           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)  
2222        end if        end if
2223    
2224        if (ok_sync) then        if (ok_sync) then
# Line 2710  contains Line 2229  contains
2229    
2230    END SUBROUTINE physiq    END SUBROUTINE physiq
2231    
   !****************************************************  
   
   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  
   
2232  end module physiq_m  end module physiq_m
Legend:
Removed from v.13  
changed lines
  Added in v.35
  ViewVC Help
Powered by ViewVC 1.1.21