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

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

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

revision 204 by guez, Wed Jun 8 15:27:32 2016 UTC revision 212 by guez, Thu Jan 12 12:31:31 2017 UTC
# Line 20  contains Line 20  contains
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
21      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ksta, ksta_ter, ok_kzmin, &
22           ok_instan           ok_instan
23      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
          ok_orodr, ok_orolf  
24      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
25      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      use comconst, only: dtphys      use comconst, only: dtphys
27      USE comgeomphy, ONLY: airephy      USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, day_step, iphysiq, lmt_pas      USE conf_gcm_m, ONLY: offline, lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31      use conflx_m, only: conflx      use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
# Line 37  contains Line 36  contains
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      use dynetat0_m, only: day_ref, annee_ref      use dynetat0_m, only: day_ref, annee_ref
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats
40      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
# Line 56  contains Line 55  contains
55      USE phyredem0_m, ONLY: phyredem0      USE phyredem0_m, ONLY: phyredem0
56      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
57      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
59      use yoegwd, only: sugwd      use yoegwd, only: sugwd
60      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61      use time_phylmdz, only: itap, increment_itap      use time_phylmdz, only: itap, increment_itap
62      use transp_m, only: transp      use transp_m, only: transp
63      use transp_lay_m, only: transp_lay      use transp_lay_m, only: transp_lay
# Line 107  contains Line 105  contains
105    
106      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
107    
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
# Line 129  contains Line 124  contains
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126    
127      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129      SAVE swdn0, swdn, swup0, swup  
130        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      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  
132    
133      ! prw: precipitable water      ! prw: precipitable water
134      real prw(klon)      real prw(klon)
# Line 151  contains Line 144  contains
144      ! Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
145      ! "physiq".      ! "physiq".
146    
147      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  
   
148      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
149    
150      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
151      ! soil temperature of surface fraction      ! soil temperature of surface fraction
152    
153      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL, save:: fevap(klon, nbsrf) ! evaporation
154      REAL fluxlat(klon, nbsrf)      REAL, save:: fluxlat(klon, nbsrf)
     SAVE fluxlat  
155    
156      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
157      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
# Line 200  contains Line 190  contains
190      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
191      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
192      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  
193    
194      REAL fqcalving(klon, nbsrf)      REAL, save:: ffonte(klon, nbsrf)
195        ! flux thermique utilise pour fondre la neige
196    
197        REAL, save:: fqcalving(klon, nbsrf)
198      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
199      ! hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
200    
201      REAL zxffonte(klon), zxfqcalving(klon)      REAL zxffonte(klon), zxfqcalving(klon)
202    
203      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
204      save pfrac_impa      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
205      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation  
206      save pfrac_nucl      REAL, save:: pfrac_1nucl(klon, llm)
207      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      ! Produits des coefs lessi nucl (alpha = 1)
208      save pfrac_1nucl  
209      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
210      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
211    
# Line 225  contains Line 217  contains
217    
218      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
219    
220      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
221      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real devap(klon) ! derivative of the evaporation flux at the surface
222      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
223      SAVE dlw      real dsens(klon) ! derivee du flux de chaleur sensible au sol
224        REAL, save:: dlw(klon) ! derivee infra rouge
225      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
226      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
227      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
# Line 245  contains Line 238  contains
238      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
239      REAL, save:: albsol(klon) ! albedo du sol total visible      REAL, save:: albsol(klon) ! albedo du sol total visible
240      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
241        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
242    
243      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
244      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
# Line 257  contains Line 251  contains
251      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
252      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
253    
254      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
255      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur      REAL flux_t(klon, nbsrf) ! flux turbulent de chaleur à la surface
256      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_u(klon, nbsrf) ! flux turbulent de vitesse u à la surface
257      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)  
258    
259      ! 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
260      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
# Line 287  contains Line 276  contains
276      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
277      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree      REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
278    
279      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
280    
281      REAL dist, mu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
282      real longi      real longi
283      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
284      REAL za, zb      REAL zb
285      REAL zx_t, zx_qs, zcor      REAL zx_t, zx_qs, zcor
286      real zqsat(klon, llm)      real zqsat(klon, llm)
287      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
288      REAL zphi(klon, llm)      REAL zphi(klon, llm)
289    
290      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
# Line 306  contains Line 294  contains
294      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
295      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
296      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
297      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
298      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
299      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape
300      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition      REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition
# Line 321  contains Line 309  contains
309    
310      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
311      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
312      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
313    
314      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
315    
# Line 335  contains Line 321  contains
321      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
322      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
323      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
324      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
325      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)
326      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
327      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 351  contains Line 337  contains
337      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
338      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa      real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
339    
340      REAL rain_con(klon), rain_lsc(klon)      REAL, save:: rain_con(klon)
341        real rain_lsc(klon)
342      REAL, save:: snow_con(klon) ! neige (mm / s)      REAL, save:: snow_con(klon) ! neige (mm / s)
343      real snow_lsc(klon)      real snow_lsc(klon)
344      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
# Line 397  contains Line 384  contains
384      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.
385    
386      real date0      real date0
   
     ! Variables li\'ees au bilan d'\'energie et d'enthalpie :  
387      REAL ztsol(klon)      REAL ztsol(klon)
388    
389      REAL d_t_ec(klon, llm)      REAL d_t_ec(klon, llm)
# Line 406  contains Line 391  contains
391    
392      REAL ZRCPD      REAL ZRCPD
393    
394      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
395      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m      ! temperature and humidity at 2 m
396      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
397      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
398        REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
399        REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes sur 1 maille
400    
401      ! Aerosol effects:      ! Aerosol effects:
402    
# Line 428  contains Line 415  contains
415      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
416      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
417    
418      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
419      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL, save:: topswai(klon), solswai(klon) ! aerosol indirect effect
420    
421      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
422      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
# Line 439  contains Line 426  contains
426      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
427      ! concentration.      ! concentration.
428    
     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  
   
429      real zmasse(klon, llm)      real zmasse(klon, llm)
430      ! (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)
431    
# Line 497  contains Line 470  contains
470         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
471         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
472         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
473         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
474         therm =0.         therm =0.
475         trmb1 =0. ! deep_cape         trmb1 =0. ! deep_cape
476         trmb2 =0. ! inhibition         trmb2 =0. ! inhibition
# Line 595  contains Line 568  contains
568    
569      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
570    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
571      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
572      DO k = 1, llm      DO k = 1, llm
573         DO i = 1, klon         DO i = 1, klon
# Line 616  contains Line 586  contains
586      ! la surface.      ! la surface.
587    
588      CALL orbite(REAL(julien), longi, dist)      CALL orbite(REAL(julien), longi, dist)
589      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(longi, time, dtphys * radpas, mu0, fract)  
     ELSE  
        mu0 = - 999.999  
     ENDIF  
590    
591      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
592      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
# Line 636  contains Line 602  contains
602    
603      fder = dlw      fder = dlw
604    
     ! Couche limite:  
   
605      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, &
606           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &           ftsol, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
607           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &           paprs, play, fsnow, fqsurf, fevap, falbe, fluxlat, rain_fall, &
608           snow_fall, fsolsw, fsollw, fder, rlat, frugs, agesno, rugoro, &           snow_fall, fsolsw, fsollw, fder, frugs, agesno, rugoro, d_t_vdf, &
609           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
610           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &           cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, &
611           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &           v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, &
612           trmb3, plcl, fqcalving, ffonte, run_off_lic_0)           plcl, fqcalving, ffonte, run_off_lic_0)
613    
614      ! Incr\'ementation des flux      ! Incr\'ementation des flux
615    
616      zxfluxt = 0.      sens = - sum(flux_t * pctsrf, dim = 2)
617      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
618      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  
619    
620      DO k = 1, llm      DO k = 1, llm
621         DO i = 1, klon         DO i = 1, klon
# Line 680  contains Line 628  contains
628    
629      ! Update surface temperature:      ! Update surface temperature:
630    
     DO i = 1, klon  
        zxfluxlat(i) = 0.  
   
        zt2m(i) = 0.  
        zq2m(i) = 0.  
        zu10m(i) = 0.  
        zv10m(i) = 0.  
        zxffonte(i) = 0.  
        zxfqcalving(i) = 0.  
   
        s_pblh(i) = 0.  
        s_lcl(i) = 0.  
        s_capCL(i) = 0.  
        s_oliqCL(i) = 0.  
        s_cteiCL(i) = 0.  
        s_pblT(i) = 0.  
        s_therm(i) = 0.  
        s_trmb1(i) = 0.  
        s_trmb2(i) = 0.  
        s_trmb3(i) = 0.  
     ENDDO  
   
631      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
   
632      ftsol = ftsol + d_ts      ftsol = ftsol + d_ts
633      zxtsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
634      DO nsrf = 1, nbsrf      zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
635         DO i = 1, klon      zt2m = sum(t2m * pctsrf, dim = 2)
636            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf) * pctsrf(i, nsrf)      zq2m = sum(q2m * pctsrf, dim = 2)
637        zu10m = sum(u10m * pctsrf, dim = 2)
638            zt2m(i) = zt2m(i) + t2m(i, nsrf) * pctsrf(i, nsrf)      zv10m = sum(v10m * pctsrf, dim = 2)
639            zq2m(i) = zq2m(i) + q2m(i, nsrf) * pctsrf(i, nsrf)      zxffonte = sum(ffonte * pctsrf, dim = 2)
640            zu10m(i) = zu10m(i) + u10m(i, nsrf) * pctsrf(i, nsrf)      zxfqcalving = sum(fqcalving * pctsrf, dim = 2)
641            zv10m(i) = zv10m(i) + v10m(i, nsrf) * pctsrf(i, nsrf)      s_pblh = sum(pblh * pctsrf, dim = 2)
642            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf) * pctsrf(i, nsrf)      s_lcl = sum(plcl * pctsrf, dim = 2)
643            zxfqcalving(i) = zxfqcalving(i) + &      s_capCL = sum(capCL * pctsrf, dim = 2)
644                 fqcalving(i, nsrf) * pctsrf(i, nsrf)      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
645            s_pblh(i) = s_pblh(i) + pblh(i, nsrf) * pctsrf(i, nsrf)      s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
646            s_lcl(i) = s_lcl(i) + plcl(i, nsrf) * pctsrf(i, nsrf)      s_pblT = sum(pblT * pctsrf, dim = 2)
647            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) * pctsrf(i, nsrf)      s_therm = sum(therm * pctsrf, dim = 2)
648            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) * pctsrf(i, nsrf)      s_trmb1 = sum(trmb1 * pctsrf, dim = 2)
649            s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) * pctsrf(i, nsrf)      s_trmb2 = sum(trmb2 * pctsrf, dim = 2)
650            s_pblT(i) = s_pblT(i) + pblT(i, nsrf) * pctsrf(i, nsrf)      s_trmb3 = sum(trmb3 * pctsrf, dim = 2)
           s_therm(i) = s_therm(i) + therm(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) * pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
651    
652      ! 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 :
653      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
654         DO i = 1, klon         DO i = 1, klon
655            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf) < epsfra) then
656                 ftsol(i, nsrf) = ztsol(i)
657            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)               t2m(i, nsrf) = zt2m(i)
658            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)               q2m(i, nsrf) = zq2m(i)
659            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)               u10m(i, nsrf) = zu10m(i)
660            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)               v10m(i, nsrf) = zv10m(i)
661            IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)               ffonte(i, nsrf) = zxffonte(i)
662            IF (pctsrf(i, nsrf) < epsfra) &               fqcalving(i, nsrf) = zxfqcalving(i)
663                 fqcalving(i, nsrf) = zxfqcalving(i)               pblh(i, nsrf) = s_pblh(i)
664            IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)               plcl(i, nsrf) = s_lcl(i)
665            IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)               capCL(i, nsrf) = s_capCL(i)
666            IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)               oliqCL(i, nsrf) = s_oliqCL(i)
667            IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)               cteiCL(i, nsrf) = s_cteiCL(i)
668            IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)               pblT(i, nsrf) = s_pblT(i)
669            IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)               therm(i, nsrf) = s_therm(i)
670            IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)               trmb1(i, nsrf) = s_trmb1(i)
671            IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)               trmb2(i, nsrf) = s_trmb2(i)
672            IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)               trmb3(i, nsrf) = s_trmb3(i)
673            IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)            end IF
674         ENDDO         ENDDO
675      ENDDO      ENDDO
676    
677      ! Calculer la dérive du flux infrarouge      ! Calculer la dérive du flux infrarouge
678    
679      DO i = 1, klon      DO i = 1, klon
680         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * ztsol(i)**3
681      ENDDO      ENDDO
682    
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
683      ! Appeler la convection      ! Appeler la convection
684    
685      if (conv_emanuel) then      if (conv_emanuel) then
        da = 0.  
        mp = 0.  
        phi = 0.  
686         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, &
687              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, &
688              upwd, dnwd, dnwd0, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)              upwd, dnwd, Ma, cape, iflagctrl, qcondc, pmflxr, da, phi, mp)
689         snow_con = 0.         snow_con = 0.
690         clwcon0 = qcondc         clwcon0 = qcondc
691         mfu = upwd + dnwd         mfu = upwd + dnwd
692    
693         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
694            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  
695    
696         ! Properties of convective clouds         ! Properties of convective clouds
697         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
# Line 799  contains Line 709  contains
709         conv_t = d_t_dyn + d_t_vdf / dtphys         conv_t = d_t_dyn + d_t_vdf / dtphys
710         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
711         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
712              q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:- 1), conv_t, conv_q, - evap, omega, &
713              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), &
714              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, &
715              kdtop, pmflxr, pmflxs)              kdtop, pmflxr, pmflxs)
# Line 818  contains Line 728  contains
728         ENDDO         ENDDO
729      ENDDO      ENDDO
730    
     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  
   
731      IF (.not. conv_emanuel) THEN      IF (.not. conv_emanuel) THEN
732         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
733         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
# Line 917  contains Line 813  contains
813            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
814         ENDDO         ENDDO
815      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  
816    
817      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
818    
# Line 1008  contains Line 891  contains
891      DO k = 1, llm      DO k = 1, llm
892         DO i = 1, klon         DO i = 1, klon
893            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
894            IF (thermcep) THEN            zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)
895               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t) / play(i, k)            zx_qs = MIN(0.5, zx_qs)
896               zx_qs = MIN(0.5, zx_qs)            zcor = 1. / (1. - retv * zx_qs)
897               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  
898            zx_rh(i, k) = q_seri(i, k) / zx_qs            zx_rh(i, k) = q_seri(i, k) / zx_qs
899            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
900         ENDDO         ENDDO
# Line 1043  contains Line 918  contains
918      endif      endif
919    
920      IF (MOD(itap - 1, radpas) == 0) THEN      IF (MOD(itap - 1, radpas) == 0) THEN
921           ! Prescrire l'ozone :
922           wo = ozonecm(REAL(julien), paprs)
923    
924         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
925         ! Calcul de l'abedo moyen par maille         ! Calcul de l'abedo moyen par maille
926         albsol = sum(falbe * pctsrf, dim = 2)         albsol = sum(falbe * pctsrf, dim = 2)
927    
928         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
929         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &         CALL radlwsw(dist, mu0, fract, paprs, play, ztsol, albsol, t_seri, &
930              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
931              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
932              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
# Line 1057  contains Line 935  contains
935      ENDIF      ENDIF
936    
937      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
938      DO k = 1, llm      DO k = 1, llm
939         DO i = 1, klon         DO i = 1, klon
940            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys &
# Line 1066  contains Line 943  contains
943      ENDDO      ENDDO
944    
945      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
946      DO i = 1, klon      zxqsurf = sum(fqsurf * pctsrf, dim = 2)
947         zxqsurf(i) = 0.      zxsnow = sum(fsnow * pctsrf, dim = 2)
        zxsnow(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf) * pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf) * pctsrf(i, nsrf)  
        ENDDO  
     ENDDO  
948    
949      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
   
950      DO i = 1, klon      DO i = 1, klon
951         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
952      ENDDO      ENDDO
# Line 1228  contains Line 1096  contains
1096      CALL histwrite_phy("precip", rain_fall + snow_fall)      CALL histwrite_phy("precip", rain_fall + snow_fall)
1097      CALL histwrite_phy("plul", rain_lsc + snow_lsc)      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
1098      CALL histwrite_phy("pluc", rain_con + snow_con)      CALL histwrite_phy("pluc", rain_con + snow_con)
1099      CALL histwrite_phy("tsol", zxtsol)      CALL histwrite_phy("tsol", ztsol)
1100      CALL histwrite_phy("t2m", zt2m)      CALL histwrite_phy("t2m", zt2m)
1101      CALL histwrite_phy("q2m", zq2m)      CALL histwrite_phy("q2m", zq2m)
1102      CALL histwrite_phy("u10m", zu10m)      CALL histwrite_phy("u10m", zu10m)
# Line 1252  contains Line 1120  contains
1120      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1121         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)         CALL histwrite_phy("pourc_"//clnsurf(nsrf), pctsrf(:, nsrf) * 100.)
1122         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1123         CALL histwrite_phy("sens_"//clnsurf(nsrf), fluxt(:, 1, nsrf))         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1124         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1125         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1126         CALL histwrite_phy("taux_"//clnsurf(nsrf), fluxu(:, 1, nsrf))         CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1127         CALL histwrite_phy("tauy_"//clnsurf(nsrf), fluxv(:, 1, nsrf))         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1128         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1129         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))         CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1130      END DO      END DO
1131    
1132      CALL histwrite_phy("albs", albsol)      CALL histwrite_phy("albs", albsol)
1133        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1134      CALL histwrite_phy("rugs", zxrugs)      CALL histwrite_phy("rugs", zxrugs)
1135      CALL histwrite_phy("s_pblh", s_pblh)      CALL histwrite_phy("s_pblh", s_pblh)
1136      CALL histwrite_phy("s_pblt", s_pblt)      CALL histwrite_phy("s_pblt", s_pblt)
# Line 1273  contains Line 1142  contains
1142      CALL histwrite_phy("s_trmb1", s_trmb1)      CALL histwrite_phy("s_trmb1", s_trmb1)
1143      CALL histwrite_phy("s_trmb2", s_trmb2)      CALL histwrite_phy("s_trmb2", s_trmb2)
1144      CALL histwrite_phy("s_trmb3", s_trmb3)      CALL histwrite_phy("s_trmb3", s_trmb3)
1145      if (conv_emanuel) CALL histwrite_phy("ptop", ema_pct)  
1146        if (conv_emanuel) then
1147           CALL histwrite_phy("ptop", ema_pct)
1148           CALL histwrite_phy("dnwd0", - mp)
1149        end if
1150    
1151      CALL histwrite_phy("temp", t_seri)      CALL histwrite_phy("temp", t_seri)
1152      CALL histwrite_phy("vitu", u_seri)      CALL histwrite_phy("vitu", u_seri)
1153      CALL histwrite_phy("vitv", v_seri)      CALL histwrite_phy("vitv", v_seri)

Legend:
Removed from v.204  
changed lines
  Added in v.212

  ViewVC Help
Powered by ViewVC 1.1.21