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

Diff of /trunk/phylmd/physiq.f

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

revision 202 by guez, Wed Jun 8 12:23:41 2016 UTC revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 27  contains Line 27  contains
27      use comconst, only: dtphys      use comconst, only: dtphys
28      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, day_step, iphysiq, lmt_pas      USE conf_gcm_m, ONLY: offline, lmt_pas
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
32      use conflx_m, only: conflx      use conflx_m, only: conflx
33      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
34      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
     use diagetpq_m, only: diagetpq  
     use diagphy_m, only: diagphy  
35      USE dimens_m, ONLY: llm, nqmx      USE dimens_m, ONLY: llm, nqmx
36      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_m, only: day_ref, annee_ref
40      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats
41      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
42      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
43      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
# Line 58  contains Line 56  contains
56      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
59      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
60      use yoegwd, only: sugwd      use yoegwd, only: sugwd
61      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
# Line 109  contains Line 106  contains
106    
107      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
108    
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
109      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
110      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
111    
# Line 131  contains Line 125  contains
125    
126      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
127    
128      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
129      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
130      SAVE swdn0, swdn, swup0, swup  
131        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
132      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
133    
134      ! prw: precipitable water      ! prw: precipitable water
135      real prw(klon)      real prw(klon)
# Line 153  contains Line 145  contains
145      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
146      ! "physiq".      ! "physiq".
147    
148      REAL radsol(klon)      REAL, save:: radsol(klon) ! bilan radiatif au sol calcule par code radiatif
     SAVE radsol ! bilan radiatif au sol calcule par code radiatif  
149    
150      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
151    
# Line 162  contains Line 153  contains
153      ! soil temperature of surface fraction      ! soil temperature of surface fraction
154    
155      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
156      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
157    
158      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 202  contains Line 192  contains
192      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
193      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
194      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
     REAL ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige  
195    
196      REAL fqcalving(klon, nbsrf)      REAL, save:: ffonte(klon, nbsrf)
197        ! flux thermique utilise pour fondre la neige
198    
199        REAL, save:: fqcalving(klon, nbsrf)
200      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
201      ! hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
202    
203      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
204    
205      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
206      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
207      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
208      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
209      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
210      save pfrac_1nucl  
211      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
212      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
213    
# Line 227  contains Line 219  contains
219    
220      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
221    
222      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
223      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
224      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
225      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
226        REAL, save:: dlw(klon) ! derivee infra rouge
227      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
228      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
229      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
# Line 259  contains Line 252  contains
252      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
253      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
254    
255      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
256      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
257      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
258      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      REAL flux_v(klon, nbsrf) ! flux turbulent de vitesse v à la surface
   
     REAL zxfluxt(klon, llm)  
     REAL zxfluxq(klon, llm)  
     REAL zxfluxu(klon, llm)  
     REAL zxfluxv(klon, llm)  
259    
260      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
261      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 289  contains Line 277  contains
277      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
278      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
279    
280      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
281    
282      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
283      real longi      real longi
284      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
285      REAL za, zb      REAL zb
286      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
287      real zqsat(klon, llm)      real zqsat(klon, llm)
288      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
289      REAL zphi(klon, llm)      REAL zphi(klon, llm)
290    
291      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
# Line 308  contains Line 295  contains
295      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
296      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
297      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
298      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
299      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
300      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
301      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
# Line 323  contains Line 310  contains
310    
311      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
312      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
313      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
314    
315      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
316    
# Line 337  contains Line 322  contains
322      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
323      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
324      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
325      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
326      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
327      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
328      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 353  contains Line 338  contains
338      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
339      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
340    
341      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
342        real rain_lsc(klon)
343      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
344      real snow_lsc(klon)      real snow_lsc(klon)
345      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
# Line 399  contains Line 385  contains
385      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
386    
387      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
388      REAL ztsol(klon)      REAL ztsol(klon)
     REAL d_h_vcol, d_qt, d_ec  
     REAL, SAVE:: d_h_vcol_phy  
     REAL zero_v(klon)  
     CHARACTER(LEN = 20) tit  
     INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
     INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation  
389    
390      REAL d_t_ec(klon, llm)      REAL d_t_ec(klon, llm)
391      ! tendance due \`a la conversion Ec en énergie thermique      ! tendance due \`a la conversion Ec en énergie thermique
392    
393      REAL ZRCPD      REAL ZRCPD
394    
395      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
396      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
397      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
398      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille      REAL, save:: u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
399        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
400        REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
401    
402      ! Aerosol effects:      ! Aerosol effects:
403    
# Line 436  contains Line 416  contains
416      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
417      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
418    
419      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
420      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
421    
422      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
423      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 447  contains Line 427  contains
427      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
428      ! concentration.      ! concentration.
429    
     SAVE u10m  
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
430      real zmasse(klon, llm)      real zmasse(klon, llm)
431      ! (column-density of mass of air in a cell, in kg m-2)      ! (column-density of mass of air in a cell, in kg m-2)
432    
433      integer, save:: ncid_startphy      integer, save:: ncid_startphy
434    
435      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
436           iflag_cldcon, ratqsbas, ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, &           ratqsbas, ratqshaut, ok_ade, ok_aie, bl95_b0, bl95_b1, &
437           bl95_b1, iflag_thermals, nsplit_thermals           iflag_thermals, nsplit_thermals
438    
439      !----------------------------------------------------------------      !----------------------------------------------------------------
440    
     IF (if_ebil >= 1) zero_v = 0.  
441      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
442           'eaux vapeur et liquide sont indispensables')           'eaux vapeur et liquide sont indispensables')
443    
# Line 506  contains Line 471  contains
471         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
472         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
473         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
474         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
475         therm =0.         therm =0.
476         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
477         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
478         trmb3 =0. ! Point Omega         trmb3 =0. ! Point Omega
479    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
480         iflag_thermals = 0         iflag_thermals = 0
481         nsplit_thermals = 1         nsplit_thermals = 1
482         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
# Line 572  contains Line 535  contains
535    
536      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
537    
     IF (if_ebil >= 1) THEN  
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajout\'es dans la  
        ! dynamique, la variation d'enthalpie par la dynamique devrait  
        ! \^etre \'egale \`a la variation de la physique au pas de temps  
        ! pr\'ec\'edent. Donc la somme de ces 2 variations devrait \^etre  
        ! nulle.  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &  
             d_qt, 0.)  
     END IF  
   
538      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
539      IF (ancien_ok) THEN      IF (ancien_ok) THEN
540         DO k = 1, llm         DO k = 1, llm
# Line 634  contains Line 583  contains
583      ENDDO      ENDDO
584      ql_seri = 0.      ql_seri = 0.
585    
     IF (if_ebil >= 2) THEN  
        tit = 'after reevap'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
586      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
587      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
588    
# Line 669  contains Line 610  contains
610    
611      fder = dlw      fder = dlw
612    
     ! Couche limite:  
   
613      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &      CALL clmain(dtphys, pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
614           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
615           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
616           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &
617           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, &
618           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &           flux_v, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &
619           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &
620           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
621    
622      ! Incr\'ementation des flux      ! Incr\'ementation des flux
623    
624      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
625      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
626      zxfluxu = 0.      fder = dlw + dsens + devap
     zxfluxv = 0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
627    
628      DO k = 1, llm      DO k = 1, llm
629         DO i = 1, klon         DO i = 1, klon
# Line 711  contains Line 634  contains
634         ENDDO         ENDDO
635      ENDDO      ENDDO
636    
     IF (if_ebil >= 2) THEN  
        tit = 'after clmain'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
637      ! Update surface temperature:      ! Update surface temperature:
638    
639      DO i = 1, klon      DO i = 1, klon
# Line 746  contains Line 661  contains
661      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
662    
663      ftsol = ftsol + d_ts      ftsol = ftsol + d_ts
664      zxtsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
665      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
666         DO i = 1, klon         DO i = 1, klon
667            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)
# Line 771  contains Line 686  contains
686         ENDDO         ENDDO
687      ENDDO      ENDDO
688    
689      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
690      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
691         DO i = 1, klon         DO i = 1, klon
692            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
693                 ftsol(i, nsrf) = ztsol(i)
694            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
695            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
696            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
697            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
698            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
699            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
700                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
701            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
702            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
703            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
704            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
705            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
706            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
707            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
708            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
709            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
710            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
711         ENDDO         ENDDO
712      ENDDO      ENDDO
713    
714      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
715    
716      DO i = 1, klon      DO i = 1, klon
717         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
718      ENDDO      ENDDO
719    
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
720      ! Appeler la convection      ! Appeler la convection
721    
722      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
723         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
724              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
725              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
726         snow_con = 0.         snow_con = 0.
727         clwcon0 = qcondc         clwcon0 = qcondc
728         mfu = upwd + dnwd         mfu = upwd + dnwd
729    
730         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
731            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)         zqsat = zqsat / (1. - retv * zqsat)
           zqsat = zqsat / (1. - retv * zqsat)  
        ELSE  
           zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play  
        ENDIF  
732    
733         ! Properties of convective clouds         ! Properties of convective clouds
734         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 840  contains Line 746  contains
746         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
747         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
748         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
749              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
750              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
751              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &              mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
752              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
# Line 859  contains Line 765  contains
765         ENDDO         ENDDO
766      ENDDO      ENDDO
767    
     IF (if_ebil >= 2) THEN  
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
768      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
769         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
770         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 912  contains Line 796  contains
796              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)              q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
797      endif      endif
798    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
     END IF  
   
799      ! Caclul des ratqs      ! Caclul des ratqs
800    
801      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q      ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
# Line 972  contains Line 850  contains
850            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
851         ENDDO         ENDDO
852      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i) / REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i)) * airephy(i) / REAL(klon)  
        ENDDO  
        zx_t = zx_t / za * dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        tit = 'after fisrt'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
853    
854      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
855    
# Line 1067  contains Line 924  contains
924         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
925      ENDDO      ENDDO
926    
     IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &  
          dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
   
927      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
928      DO k = 1, llm      DO k = 1, llm
929         DO i = 1, klon         DO i = 1, klon
930            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
931            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
932               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)            zx_qs = MIN(0.5, zx_qs)
933               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
934               zcor = 1. / (1. - retv * zx_qs)            zx_qs = zx_qs * zcor
              zx_qs = zx_qs * zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t) / play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t) / play(i, k)  
              ENDIF  
           ENDIF  
935            zx_rh(i, k) = q_seri(i, k) / zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
936            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
937         ENDDO         ENDDO
# Line 1115  contains Line 960  contains
960         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
961    
962         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
963         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
964              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
965              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
966              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1132  contains Line 977  contains
977         ENDDO         ENDDO
978      ENDDO      ENDDO
979    
     IF (if_ebil >= 2) THEN  
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
980      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
981      DO i = 1, klon      DO i = 1, klon
982         zxqsurf(i) = 0.         zxqsurf(i) = 0.
# Line 1228  contains Line 1065  contains
1065      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1066           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1067    
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &  
          2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
   
1068      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1069      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &      call phytrac(julien, time, firstcal, lafin, dtphys, t, paprs, play, mfu, &
1070           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
# Line 1263  contains Line 1096  contains
1096         END DO         END DO
1097      END DO      END DO
1098    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajoute dans la dynamique,  
        ! on devrait avoir que la variation d'entalpie par la dynamique  
        ! est egale a la variation de la physique au pas de temps precedent.  
        ! Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &  
             evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec)  
        d_h_vcol_phy = d_h_vcol  
     END IF  
   
1099      ! SORTIES      ! SORTIES
1100    
1101      ! prw = eau precipitable      ! prw = eau precipitable
# Line 1320  contains Line 1140  contains
1140      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1141      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1142      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1143      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", ztsol)
1144      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1145      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1146      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", zu10m)
# Line 1344  contains Line 1164  contains
1164      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1165         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1166         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1167         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1168         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1169         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1170         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1171         CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1172         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1173         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1174      END DO      END DO
# Line 1365  contains Line 1185  contains
1185      CALL histwrite_phy("s_trmb1", s_trmb1)      CALL histwrite_phy("s_trmb1", s_trmb1)
1186      CALL histwrite_phy("s_trmb2", s_trmb2)      CALL histwrite_phy("s_trmb2", s_trmb2)
1187      CALL histwrite_phy("s_trmb3", s_trmb3)      CALL histwrite_phy("s_trmb3", s_trmb3)
1188      if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1189        if (conv_emanuel) then
1190           CALL histwrite_phy("ptop", ema_pct)
1191           CALL histwrite_phy("dnwd0", - mp)
1192        end if
1193    
1194      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1195      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1196      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)
Legend:
Removed from v.202  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21