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

Diff of /trunk/phylmd/physiq.f

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

trunk/libf/phylmd/physiq.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/phylmd/physiq.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 5  module physiq_m Line 5  module physiq_m
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn, PVteta)         u, v, t, qx, omega, d_u, d_v, d_t, d_qx, d_ps, dudyn)
9    
10        ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11        ! (subversion revision 678)
12    
     ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)  
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z.X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
17      use aaam_bud_m, only: aaam_bud      use aaam_bud_m, only: aaam_bud
18      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
19        use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
21      USE calendar, ONLY: ymds2ju      USE calendar, ONLY: ymds2ju
22      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
# Line 22  contains Line 25  contains
25      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
26           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf, soil_model
27      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
28        use clouds_gno_m, only: clouds_gno
29      USE comgeomphy, ONLY: airephy, cuphy, cvphy      USE comgeomphy, ONLY: airephy, cuphy, cvphy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
# Line 36  contains Line 40  contains
40      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
41      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
42      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43        use fisrtilp_m, only: fisrtilp
44      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
45      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
46      USE histwrite_m, ONLY: histwrite      USE histwrite_m, ONLY: histwrite
# Line 44  contains Line 49  contains
49      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histhf_m, ONLY: ini_histhf
50      USE ini_histday_m, ONLY: ini_histday      USE ini_histday_m, ONLY: ini_histday
51      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
52        use newmicro_m, only: newmicro
53      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
54      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite, zenang
55      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 53  contains Line 59  contains
59      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
60      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
61      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
62        use readsulfate_m, only: readsulfate
63      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
64      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
66        use unit_nml_m, only: unit_nml
67      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
68    
69      ! Arguments:      ! Arguments:
# Line 99  contains Line 107  contains
107      INTEGER nbteta      INTEGER nbteta
108      PARAMETER(nbteta = 3)      PARAMETER(nbteta = 3)
109    
     REAL PVteta(klon, nbteta)  
     ! (output vorticite potentielle a des thetas constantes)  
   
110      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface      LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
111      PARAMETER (ok_gust = .FALSE.)      PARAMETER (ok_gust = .FALSE.)
112    
# Line 116  contains Line 121  contains
121      logical rnpb      logical rnpb
122      parameter(rnpb = .true.)      parameter(rnpb = .true.)
123    
124      character(len = 6), save:: ocean      character(len = 6):: ocean = 'force '
125      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
126    
     logical ok_ocean  
     SAVE ok_ocean  
   
127      ! "slab" ocean      ! "slab" ocean
128      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
129      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
# Line 129  contains Line 131  contains
131      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
132    
133      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
134      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
135    
136      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
137      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
138        ! fichiers histday, histmth et histins
139    
140      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
141      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 167  contains Line 167  contains
167    
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
171      PARAMETER(klevp1 = llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
172      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
173    
174      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
175      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
176      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
177    
178      !IM Amip2      !IM Amip2
# Line 206  contains Line 203  contains
203      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
204    
205      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
206      DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./      DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./
207      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
208    
209      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 268  contains Line 265  contains
265      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
266      ! soil temperature of surface fraction      ! soil temperature of surface fraction
267    
268      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
269      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
270      SAVE fluxlat      SAVE fluxlat
271    
# Line 316  contains Line 312  contains
312      SAVE Ma      SAVE Ma
313      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
314      SAVE qcondc      SAVE qcondc
315      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
316      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
317    
318      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
319    
# Line 329  contains Line 322  contains
322      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
323      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
324    
325      !AA Pour phytrac      ! Pour phytrac :
326      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
327      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
328      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 353  contains Line 346  contains
346    
347      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
348    
349      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
350      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
351      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
352      SAVE dlw      SAVE dlw
# Line 374  contains Line 367  contains
367      INTEGER julien      INTEGER julien
368    
369      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
370      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
371      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
372    
     SAVE pctsrf ! sous-fraction du sol  
373      REAL albsol(klon)      REAL albsol(klon)
374      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
375      REAL albsollw(klon)      REAL albsollw(klon)
# Line 391  contains Line 382  contains
382      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
383      !KE43      !KE43
384      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
385      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
386      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
387    
388      ! Variables locales      ! Variables locales
389    
390      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
391      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
392    
393      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
394      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 426  contains Line 414  contains
414      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
415      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
416      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
417      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
418      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface
419        real, save:: sollwdown(klon) ! downward LW flux at surface
420      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
421      REAL albpla(klon)      REAL albpla(klon)
422      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
423      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
424      SAVE albpla, sollwdown      SAVE albpla
425      SAVE heat0, cool0      SAVE heat0, cool0
426    
427      INTEGER itaprad      INTEGER itaprad
# Line 449  contains Line 438  contains
438      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
439      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
440      real zlongi      real zlongi
   
441      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
442      REAL za, zb      REAL za, zb
443      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
444      real zqsat(klon, llm)      real zqsat(klon, llm)
445      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
446      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
447      REAL zphi(klon, llm)      REAL zphi(klon, llm)
448    
449      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
# Line 496  contains Line 480  contains
480      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
481      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
482      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
483      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
484      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
485    
# Line 514  contains Line 497  contains
497      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
498      REAL rneb(klon, llm)      REAL rneb(klon, llm)
499    
500      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
501      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
502      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
503      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
# Line 535  contains Line 518  contains
518      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
519      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
520    
521      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
522      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
523      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
524    
525      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
526      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
527      real, save:: facttemps      real:: facttemps = 1.e-4
528      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
529      real facteur      real facteur
530    
531      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
532      logical ptconv(klon, llm)      logical ptconv(klon, llm)
533    
534      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en série :
# Line 581  contains Line 561  contains
561    
562      REAL zsto      REAL zsto
563    
     character(len = 20) modname  
     character(len = 80) abort_message  
564      logical ok_sync      logical ok_sync
565      real date0      real date0
566    
# Line 594  contains Line 572  contains
572      REAL zero_v(klon)      REAL zero_v(klon)
573      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 15) tit
574      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
575      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
576    
577      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
578      REAL ZRCPD      REAL ZRCPD
579    
580      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
581      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
582      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
583      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
584      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
585      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
586    
587        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
588    
589      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
590      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
591    
592      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
593      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
594    
595      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
596      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
597    
598      ! Aerosol optical properties      ! Aerosol optical properties
599      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
600      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade = True -ADE = topswad-topsw  
601    
602        REAL topswad(klon), solswad(klon) ! aerosol direct effect
603      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_aie = True ->  
     ! ok_ade = True -AIE = topswai-topswad  
     ! ok_ade = F -AIE = topswai-topsw  
604    
605      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
606    
607      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
608      LOGICAL, save:: ok_ade ! apply aerosol direct effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
609      LOGICAL, save:: ok_aie ! Apply aerosol indirect effect  
610      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
611        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
612        ! B). They link cloud droplet number concentration to aerosol mass
613        ! concentration.
614    
     SAVE bl95_b0, bl95_b1  
615      SAVE u10m      SAVE u10m
616      SAVE v10m      SAVE v10m
617      SAVE t2m      SAVE t2m
618      SAVE q2m      SAVE q2m
619      SAVE ffonte      SAVE ffonte
620      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
621      SAVE rain_con      SAVE rain_con
622      SAVE snow_con      SAVE snow_con
623      SAVE topswai      SAVE topswai
# Line 652  contains Line 626  contains
626      SAVE solswad      SAVE solswad
627      SAVE d_u_con      SAVE d_u_con
628      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
629    
630      real zmasse(klon, llm)      real zmasse(klon, llm)
631      ! (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)
632    
633      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
634    
635        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
636             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
637             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
638             nsplit_thermals
639    
640      !----------------------------------------------------------------      !----------------------------------------------------------------
641    
642      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
     IF (if_ebil >= 1) THEN  
        DO i = 1, klon  
           zero_v(i) = 0.  
        END DO  
     END IF  
643      ok_sync = .TRUE.      ok_sync = .TRUE.
644      IF (nqmx < 2) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
645         abort_message = 'eaux vapeur et liquide sont indispensables'           'eaux vapeur et liquide sont indispensables', 1)
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
646    
647      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
648         ! initialiser         ! initialiser
# Line 687  contains Line 657  contains
657         cg_ae = 0.         cg_ae = 0.
658         rain_con(:) = 0.         rain_con(:) = 0.
659         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
660         topswai(:) = 0.         topswai(:) = 0.
661         topswad(:) = 0.         topswad(:) = 0.
662         solswai(:) = 0.         solswai(:) = 0.
663         solswad(:) = 0.         solswad(:) = 0.
664    
665         d_u_con = 0.0         d_u_con = 0.
666         d_v_con = 0.0         d_v_con = 0.
667         rnebcon0 = 0.0         rnebcon0 = 0.
668         clwcon0 = 0.0         clwcon0 = 0.
669         rnebcon = 0.0         rnebcon = 0.
670         clwcon = 0.0         clwcon = 0.
671    
672         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
673         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 714  contains Line 682  contains
682    
683         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
684    
685         ! Appel à la lecture du run.def physique         iflag_thermals = 0
686         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &         nsplit_thermals = 1
687              fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &         print *, "Enter namelist 'physiq_nml'."
688              ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, &         read(unit=*, nml=physiq_nml)
689              iflag_thermals, nsplit_thermals)         write(unit_nml, nml=physiq_nml)
690    
691           call conf_phys
692    
693         ! Initialiser les compteurs:         ! Initialiser les compteurs:
694    
# Line 727  contains Line 697  contains
697         itaprad = 0         itaprad = 0
698         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
699              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
700              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
701              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
702              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
703    
704         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
705         q2 = 1.e-8         q2 = 1e-8
706    
707         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
708    
# Line 740  contains Line 710  contains
710         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
711    
712         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
713           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
714                ok_instan, ok_region)
715    
716         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
           ok_ocean = .TRUE.  
        ENDIF  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *, 'Nbre d appels au rayonnement insuffisant'  
717            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
718            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
719            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
720         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
721    
722         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
723         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
724            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
725              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
726         ENDIF         ENDIF
727    
728         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 793  contains Line 752  contains
752         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
753         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
754         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
755         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
756         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
757      ENDIF test_firstcal      ENDIF test_firstcal
758    
759      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
760    
761      DO i = 1, klon      DO i = 1, klon
762         d_ps(i) = 0.0         d_ps(i) = 0.
763      ENDDO      ENDDO
764      DO iq = 1, nqmx      DO iq = 1, nqmx
765         DO k = 1, llm         DO k = 1, llm
766            DO i = 1, klon            DO i = 1, klon
767               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
768            ENDDO            ENDDO
769         ENDDO         ENDDO
770      ENDDO      ENDDO
# Line 866  contains Line 825  contains
825      ELSE      ELSE
826         DO k = 1, llm         DO k = 1, llm
827            DO i = 1, klon            DO i = 1, klon
828               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
829               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
830            ENDDO            ENDDO
831         ENDDO         ENDDO
832         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 890  contains Line 849  contains
849    
850      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
851    
852      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
853    
854      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
855      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 920  contains Line 879  contains
879      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
880    
881      DO i = 1, klon      DO i = 1, klon
882         zxrugs(i) = 0.0         zxrugs(i) = 0.
883      ENDDO      ENDDO
884      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
885         DO i = 1, klon         DO i = 1, klon
# Line 953  contains Line 912  contains
912         ENDDO         ENDDO
913      ENDDO      ENDDO
914    
915      ! Repartition sous maille des flux LW et SW      ! Répartition sous maille des flux longwave et shortwave
916      ! Repartition du longwave par sous-surface linearisee      ! Répartition du longwave par sous-surface linéarisée
917    
918      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
919         DO i = 1, klon         DO i = 1, klon
920            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
921                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
922            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
923         ENDDO         ENDDO
924      ENDDO      ENDDO
925    
# Line 968  contains Line 927  contains
927    
928      ! Couche limite:      ! Couche limite:
929    
930      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
931           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
932           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
933           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
934           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
935           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
936           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &           d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, &
937           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
938           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
# Line 988  contains Line 947  contains
947      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
948         DO k = 1, llm         DO k = 1, llm
949            DO i = 1, klon            DO i = 1, klon
950               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
951                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
952               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
953                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(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)  
954            END DO            END DO
955         END DO         END DO
956      END DO      END DO
957      DO i = 1, klon      DO i = 1, klon
958         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
959         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
960         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
961      ENDDO      ENDDO
962    
# Line 1027  contains Line 982  contains
982      ! Update surface temperature:      ! Update surface temperature:
983    
984      DO i = 1, klon      DO i = 1, klon
985         zxtsol(i) = 0.0         zxtsol(i) = 0.
986         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
987    
988         zt2m(i) = 0.0         zt2m(i) = 0.
989         zq2m(i) = 0.0         zq2m(i) = 0.
990         zu10m(i) = 0.0         zu10m(i) = 0.
991         zv10m(i) = 0.0         zv10m(i) = 0.
992         zxffonte(i) = 0.0         zxffonte(i) = 0.
993         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
994    
995         s_pblh(i) = 0.0         s_pblh(i) = 0.
996         s_lcl(i) = 0.0         s_lcl(i) = 0.
997         s_capCL(i) = 0.0         s_capCL(i) = 0.
998         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
999         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
1000         s_pblT(i) = 0.0         s_pblT(i) = 0.
1001         s_therm(i) = 0.0         s_therm(i) = 0.
1002         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
1003         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
1004         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
1005    
1006         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1007              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1008              THEN              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i, &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
1009      ENDDO      ENDDO
1010      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1011         DO i = 1, klon         DO i = 1, klon
# Line 1110  contains Line 1062  contains
1062      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1063    
1064      DO i = 1, klon      DO i = 1, klon
1065         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1066      ENDDO      ENDDO
1067    
1068      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1069    
1070      DO k = 1, llm      DO k = 1, llm
1071         DO i = 1, klon         DO i = 1, klon
1072            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1073                 + d_q_vdf(i, k)/dtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k) &  
                + d_t_vdf(i, k)/dtphys  
1074         ENDDO         ENDDO
1075      ENDDO      ENDDO
1076    
1077      IF (check) THEN      IF (check) THEN
1078         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1079         print *, "avantcon = ", za         print *, "avantcon = ", za
1080      ENDIF      ENDIF
     zx_ajustq = iflag_con == 2  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
1081    
1082      select case (iflag_con)      if (iflag_con == 2) then
1083      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1084         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1085              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
1086              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &
1087              pmflxs)              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1088                kdtop, pmflxr, pmflxs)
1089         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1090         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1091         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1092            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1093            itop_con(i) = llm + 1 - kctop(i)      else
1094         ENDDO         ! iflag_con >= 3
1095      case (3:)  
1096         ! number of tracers for the convection scheme of Kerry Emanuel:         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1097                v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1098                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1099                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1100                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1101                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1102           ! (number of tracers for the convection scheme of Kerry Emanuel:
1103         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1104         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1105         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.)
        ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &  
             v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &  
             d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &  
             upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &  
             dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &  
             da, phi, mp)  
        clwcon0 = qcondc  
        pmfu = upwd + dnwd  
1106    
1107         IF (.NOT. ok_gust) THEN         clwcon0 = qcondc
1108            do i = 1, klon         mfu = upwd + dnwd
1109               wd(i) = 0.0         IF (.NOT. ok_gust) wd = 0.
           enddo  
        ENDIF  
1110    
1111         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1112    
# Line 1183  contains Line 1115  contains
1115               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1116               IF (thermcep) THEN               IF (thermcep) THEN
1117                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1118                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1119                  zx_qs = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1120                  zcor = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1121                  zx_qs = zx_qs*zcor                  zx_qs = zx_qs*zcor
# Line 1199  contains Line 1131  contains
1131         ENDDO         ENDDO
1132    
1133         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1134         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1135         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1136              rnebcon0)              rnebcon0)
1137      case default  
1138         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1139         stop 1         pen_u = 0.
1140      END select         pen_d = 0.
1141           pde_d = 0.
1142           pde_u = 0.
1143        END if
1144    
1145      DO k = 1, llm      DO k = 1, llm
1146         DO i = 1, klon         DO i = 1, klon
# Line 1229  contains Line 1164  contains
1164      IF (check) THEN      IF (check) THEN
1165         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1166         print *, "aprescon = ", za         print *, "aprescon = ", za
1167         zx_t = 0.0         zx_t = 0.
1168         za = 0.0         za = 0.
1169         DO i = 1, klon         DO i = 1, klon
1170            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1171            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
# Line 1239  contains Line 1174  contains
1174         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1175         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1176      ENDIF      ENDIF
1177      IF (zx_ajustq) THEN  
1178         DO i = 1, klon      IF (iflag_con == 2) THEN
1179            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1180         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &  
                /z_apres(i)  
        ENDDO  
1181         DO k = 1, llm         DO k = 1, llm
1182            DO i = 1, klon            DO i = 1, klon
1183               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
# Line 1261  contains Line 1186  contains
1186            ENDDO            ENDDO
1187         ENDDO         ENDDO
1188      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1189    
1190      ! Convection sèche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1191    
# Line 1292  contains Line 1216  contains
1216    
1217      ! Caclul des ratqs      ! Caclul des ratqs
1218    
1219      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q
1220      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1221      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1222         do k = 1, llm         do k = 1, llm
1223            do i = 1, klon            do i = 1, klon
1224               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1225                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1226                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1227               else               else
1228                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1229               endif               endif
# Line 1310  contains Line 1234  contains
1234      ! ratqs stables      ! ratqs stables
1235      do k = 1, llm      do k = 1, llm
1236         do i = 1, klon         do i = 1, klon
1237            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1238                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1239         enddo         enddo
1240      enddo      enddo
1241    
1242      ! ratqs final      ! ratqs final
1243      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1244         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1245         ! ratqs final         ! ratqs final
1246         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1247         ! relaxation des ratqs         ! relaxation des ratqs
1248         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1249         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1250      else      else
1251         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1252         ratqs = ratqss         ratqs = ratqss
1253      endif      endif
1254    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1255      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1256           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &
1257           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &
# Line 1350  contains Line 1271  contains
1271      IF (check) THEN      IF (check) THEN
1272         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1273         print *, "apresilp = ", za         print *, "apresilp = ", za
1274         zx_t = 0.0         zx_t = 0.
1275         za = 0.0         za = 0.
1276         DO i = 1, klon         DO i = 1, klon
1277            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1278            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
# Line 1393  contains Line 1314  contains
1314         endif         endif
1315    
1316         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1317         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1318              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1319         DO k = 1, llm         DO k = 1, llm
1320            DO i = 1, klon            DO i = 1, klon
1321               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1405  contains Line 1325  contains
1325            ENDDO            ENDDO
1326         ENDDO         ENDDO
1327      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1328         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1329         ! convection et du calcul du pas de temps précédent diminué d'un facteur         ! la convection et du calcul du pas de temps précédent diminué
1330         ! facttemps         ! d'un facteur facttemps.
1331         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1332         do k = 1, llm         do k = 1, llm
1333            do i = 1, klon            do i = 1, klon
1334               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1335               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1336                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1337                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1338                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1339               endif               endif
# Line 1472  contains Line 1392  contains
1392      ENDDO      ENDDO
1393    
1394      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003  
1395      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1396         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1397         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1398         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1399    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1400         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1401              aerindex)              aerindex)
1402      ELSE      ELSE
# Line 1489  contains Line 1407  contains
1407    
1408      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
1409      if (ok_newmicro) then      if (ok_newmicro) then
1410         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1411              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1412              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1413      else      else
1414         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1415              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
# Line 1542  contains Line 1459  contains
1459    
1460      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1461      DO i = 1, klon      DO i = 1, klon
1462         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1463         zxsnow(i) = 0.0         zxsnow(i) = 0.
1464      ENDDO      ENDDO
1465      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1466         DO i = 1, klon         DO i = 1, klon
# Line 1565  contains Line 1482  contains
1482         igwd = 0         igwd = 0
1483         DO i = 1, klon         DO i = 1, klon
1484            itest(i) = 0            itest(i) = 0
1485            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1486               itest(i) = 1               itest(i) = 1
1487               igwd = igwd + 1               igwd = igwd + 1
1488               idx(igwd) = i               idx(igwd) = i
# Line 1636  contains Line 1553  contains
1553    
1554      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1555      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1556           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, &
1557           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, &
1558           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           albsol, rhcl, cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, &
1559           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1560    
1561      IF (offline) THEN      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1562         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1563              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
             pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
     ENDIF  
1564    
1565      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1566      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &
# Line 1688  contains Line 1603  contains
1603    
1604      ! SORTIES      ! SORTIES
1605    
1606      !cc prw = eau precipitable      ! prw = eau precipitable
1607      DO i = 1, klon      DO i = 1, klon
1608         prw(i) = 0.         prw(i) = 0.
1609         DO k = 1, llm         DO k = 1, llm
# Line 1736  contains Line 1651  contains
1651         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1652         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1653              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1654              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1655              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1656              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1657      ENDIF      ENDIF
1658    
1659      firstcal = .FALSE.      firstcal = .FALSE.
Legend:
Removed from v.62  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21