/[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.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 7  contains Line 7  contains
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, PVteta)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28 (SVN revision 678)      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11        ! (subversion revision 678)
12    
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 116  contains Line 124  contains
124      logical rnpb      logical rnpb
125      parameter(rnpb = .true.)      parameter(rnpb = .true.)
126    
127      character(len = 6), save:: ocean      character(len = 6):: ocean = 'force '
128      ! (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")
129    
     logical ok_ocean  
     SAVE ok_ocean  
   
130      ! "slab" ocean      ! "slab" ocean
131      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
132      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
# Line 129  contains Line 134  contains
134      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
135    
136      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
137      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
138    
139      LOGICAL ok_mensuel ! sortir le fichier mensuel      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
140        ! sorties journalieres, mensuelles et instantanees dans les
141      LOGICAL ok_instan ! sortir le fichier instantane      ! fichiers histday, histmth et histins
     save ok_instan  
142    
143      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
144      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 167  contains Line 170  contains
170    
171      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
172    
173      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
174      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)  
175      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
176    
177      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
178      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
179      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
180    
181      !IM Amip2      !IM Amip2
# Line 206  contains Line 206  contains
206      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)
207    
208      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)      REAL zx_tau(kmaxm1), zx_pc(lmaxm1)
209      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./
210      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./      DATA zx_pc/50., 180., 310., 440., 560., 680., 800./
211    
212      ! cldtopres pression au sommet des nuages      ! cldtopres pression au sommet des nuages
# Line 268  contains Line 268  contains
268      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
269      ! soil temperature of surface fraction      ! soil temperature of surface fraction
270    
271      REAL fevap(klon, nbsrf)      REAL, save:: fevap(klon, nbsrf) ! evaporation
     SAVE fevap ! evaporation  
272      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
273      SAVE fluxlat      SAVE fluxlat
274    
# Line 316  contains Line 315  contains
315      SAVE Ma      SAVE Ma
316      REAL qcondc(klon, llm) ! in-cld water content from convect      REAL qcondc(klon, llm) ! in-cld water content from convect
317      SAVE qcondc      SAVE qcondc
318      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
319      SAVE ema_work1, ema_work2      REAL, save:: wd(klon)
   
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
320    
321      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
322    
# Line 329  contains Line 325  contains
325      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
326      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
327    
328      !AA Pour phytrac      ! Pour phytrac :
329      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
330      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
331      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 353  contains Line 349  contains
349    
350      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
351    
352      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation and its derivative
353      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
354      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
355      SAVE dlw      SAVE dlw
# Line 374  contains Line 370  contains
370      INTEGER julien      INTEGER julien
371    
372      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
373      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
374      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
375    
     SAVE pctsrf ! sous-fraction du sol  
376      REAL albsol(klon)      REAL albsol(klon)
377      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
378      REAL albsollw(klon)      REAL albsollw(klon)
# Line 391  contains Line 385  contains
385      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
386      !KE43      !KE43
387      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
388      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
389      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
390    
391      ! Variables locales      ! Variables locales
392    
393      real clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
394      real clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
   
     save rnebcon, clwcon  
395    
396      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humiditi relative ciel clair
397      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
# Line 426  contains Line 417  contains
417      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL heat0(klon, llm) ! chauffage solaire ciel clair
418      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
419      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair
420      REAL, save:: topsw(klon), toplw(klon), solsw(klon), sollw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
421      real sollwdown(klon) ! downward LW flux at surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant à la surface
422        real, save:: sollwdown(klon) ! downward LW flux at surface
423      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
424      REAL albpla(klon)      REAL albpla(klon)
425      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
426      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
427      SAVE albpla, sollwdown      SAVE albpla
428      SAVE heat0, cool0      SAVE heat0, cool0
429    
430      INTEGER itaprad      INTEGER itaprad
# Line 449  contains Line 441  contains
441      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
442      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
443      real zlongi      real zlongi
   
444      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
445      REAL za, zb      REAL za, zb
446      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
447      real zqsat(klon, llm)      real zqsat(klon, llm)
448      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
449      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
450      REAL zphi(klon, llm)      REAL zphi(klon, llm)
451    
452      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
# Line 496  contains Line 483  contains
483      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
484      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
485      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
486      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
487      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
488    
# Line 514  contains Line 500  contains
500      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
501      REAL rneb(klon, llm)      REAL rneb(klon, llm)
502    
503      REAL pmfu(klon, llm), pmfd(klon, llm)      REAL mfu(klon, llm), mfd(klon, llm)
504      REAL pen_u(klon, llm), pen_d(klon, llm)      REAL pen_u(klon, llm), pen_d(klon, llm)
505      REAL pde_u(klon, llm), pde_d(klon, llm)      REAL pde_u(klon, llm), pde_d(klon, llm)
506      INTEGER kcbot(klon), kctop(klon), kdtop(klon)      INTEGER kcbot(klon), kctop(klon), kdtop(klon)
# Line 535  contains Line 521  contains
521      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
522      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
523    
524      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
525      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
526      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
527    
528      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
529      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
530      real, save:: facttemps      real:: facttemps = 1.e-4
531      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
532      real facteur      real facteur
533    
534      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
535      logical ptconv(klon, llm)      logical ptconv(klon, llm)
536    
537      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en série :
# Line 581  contains Line 564  contains
564    
565      REAL zsto      REAL zsto
566    
     character(len = 20) modname  
     character(len = 80) abort_message  
567      logical ok_sync      logical ok_sync
568      real date0      real date0
569    
# Line 594  contains Line 575  contains
575      REAL zero_v(klon)      REAL zero_v(klon)
576      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 15) tit
577      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
578      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
579    
580      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
581      REAL ZRCPD      REAL ZRCPD
582    
583      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
584      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
585      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
586      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
587      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
588      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
589    
590        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
591    
592      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
593      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
594    
595      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
596      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
597    
598      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
599      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
600    
601      ! Aerosol optical properties      ! Aerosol optical properties
602      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
603      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  
604    
605        REAL topswad(klon), solswad(klon) ! aerosol direct effect
606      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  
607    
608      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
609    
610      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
611      LOGICAL, save:: ok_ade ! apply aerosol direct effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
612      LOGICAL, save:: ok_aie ! Apply aerosol indirect effect  
613      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
614        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
615        ! B). They link cloud droplet number concentration to aerosol mass
616        ! concentration.
617    
     SAVE bl95_b0, bl95_b1  
618      SAVE u10m      SAVE u10m
619      SAVE v10m      SAVE v10m
620      SAVE t2m      SAVE t2m
621      SAVE q2m      SAVE q2m
622      SAVE ffonte      SAVE ffonte
623      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
624      SAVE rain_con      SAVE rain_con
625      SAVE snow_con      SAVE snow_con
626      SAVE topswai      SAVE topswai
# Line 652  contains Line 629  contains
629      SAVE solswad      SAVE solswad
630      SAVE d_u_con      SAVE d_u_con
631      SAVE d_v_con      SAVE d_v_con
     SAVE rnebcon0  
     SAVE clwcon0  
632    
633      real zmasse(klon, llm)      real zmasse(klon, llm)
634      ! (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)
635    
636      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
637    
638        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
639             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
640             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
641             nsplit_thermals
642    
643      !----------------------------------------------------------------      !----------------------------------------------------------------
644    
645      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  
646      ok_sync = .TRUE.      ok_sync = .TRUE.
647      IF (nqmx < 2) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
648         abort_message = 'eaux vapeur et liquide sont indispensables'           'eaux vapeur et liquide sont indispensables', 1)
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
649    
650      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
651         ! initialiser         ! initialiser
# Line 687  contains Line 660  contains
660         cg_ae = 0.         cg_ae = 0.
661         rain_con(:) = 0.         rain_con(:) = 0.
662         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
663         topswai(:) = 0.         topswai(:) = 0.
664         topswad(:) = 0.         topswad(:) = 0.
665         solswai(:) = 0.         solswai(:) = 0.
666         solswad(:) = 0.         solswad(:) = 0.
667    
668         d_u_con = 0.0         d_u_con = 0.
669         d_v_con = 0.0         d_v_con = 0.
670         rnebcon0 = 0.0         rnebcon0 = 0.
671         clwcon0 = 0.0         clwcon0 = 0.
672         rnebcon = 0.0         rnebcon = 0.
673         clwcon = 0.0         clwcon = 0.
674    
675         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
676         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
# Line 714  contains Line 685  contains
685    
686         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
687    
688         ! Appel à la lecture du run.def physique         iflag_thermals = 0
689         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &         nsplit_thermals = 1
690              fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &         print *, "Enter namelist 'physiq_nml'."
691              ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, &         read(unit=*, nml=physiq_nml)
692              iflag_thermals, nsplit_thermals)         write(unit_nml, nml=physiq_nml)
693    
694           call conf_phys
695    
696         ! Initialiser les compteurs:         ! Initialiser les compteurs:
697    
# Line 727  contains Line 700  contains
700         itaprad = 0         itaprad = 0
701         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
702              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &
703              snow_fall, solsw, sollwdown, dlw, radsol, frugs, agesno, zmea, &              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &
704              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
705              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
706    
707         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
708         q2 = 1.e-8         q2 = 1e-8
709    
710         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
711    
# Line 740  contains Line 713  contains
713         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
714    
715         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
716           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
717                ok_instan, ok_region)
718    
719         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'  
720            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
721            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
722            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
723         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
724    
725         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
726         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
727            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
728              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
729         ENDIF         ENDIF
730    
731         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 793  contains Line 755  contains
755         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
756         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
757         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
758         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
759         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
760      ENDIF test_firstcal      ENDIF test_firstcal
761    
762      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
763    
764      DO i = 1, klon      DO i = 1, klon
765         d_ps(i) = 0.0         d_ps(i) = 0.
766      ENDDO      ENDDO
767      DO iq = 1, nqmx      DO iq = 1, nqmx
768         DO k = 1, llm         DO k = 1, llm
769            DO i = 1, klon            DO i = 1, klon
770               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
771            ENDDO            ENDDO
772         ENDDO         ENDDO
773      ENDDO      ENDDO
# Line 866  contains Line 828  contains
828      ELSE      ELSE
829         DO k = 1, llm         DO k = 1, llm
830            DO i = 1, klon            DO i = 1, klon
831               d_t_dyn(i, k) = 0.0               d_t_dyn(i, k) = 0.
832               d_q_dyn(i, k) = 0.0               d_q_dyn(i, k) = 0.
833            ENDDO            ENDDO
834         ENDDO         ENDDO
835         ancien_ok = .TRUE.         ancien_ok = .TRUE.
# Line 890  contains Line 852  contains
852    
853      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
854    
855      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
856    
857      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
858      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 920  contains Line 882  contains
882      ! Appeler la diffusion verticale (programme de couche limite)      ! Appeler la diffusion verticale (programme de couche limite)
883    
884      DO i = 1, klon      DO i = 1, klon
885         zxrugs(i) = 0.0         zxrugs(i) = 0.
886      ENDDO      ENDDO
887      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
888         DO i = 1, klon         DO i = 1, klon
# Line 953  contains Line 915  contains
915         ENDDO         ENDDO
916      ENDDO      ENDDO
917    
918      ! Repartition sous maille des flux LW et SW      ! Répartition sous maille des flux longwave et shortwave
919      ! Repartition du longwave par sous-surface linearisee      ! Répartition du longwave par sous-surface linéarisée
920    
921      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
922         DO i = 1, klon         DO i = 1, klon
923            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
924                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
925            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
926         ENDDO         ENDDO
927      ENDDO      ENDDO
928    
# Line 968  contains Line 930  contains
930    
931      ! Couche limite:      ! Couche limite:
932    
933      CALL clmain(dtphys, itap, date0, pctsrf, pctsrf_new, t_seri, q_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, &
934           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, &           u_seri, v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, &
935           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &           ftsol, soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &
936           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &           qsol, paprs, play, fsnow, fqsurf, fevap, falbe, falblw, fluxlat, &
937           rain_fall, snow_fall, fsolsw, fsollw, sollwdown, fder, rlon, rlat, &           rain_fall, snow_fall, fsolsw, fsollw, fder, rlon, rlat, &
938           cuphy, cvphy, frugs, firstcal, lafin, agesno, rugoro, d_t_vdf, &           frugs, firstcal, agesno, rugoro, d_t_vdf, &
939           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, &
940           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &           cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, &
941           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
# Line 988  contains Line 950  contains
950      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
951         DO k = 1, llm         DO k = 1, llm
952            DO i = 1, klon            DO i = 1, klon
953               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
954                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
955               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
956                    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)  
957            END DO            END DO
958         END DO         END DO
959      END DO      END DO
960      DO i = 1, klon      DO i = 1, klon
961         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
962         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
963         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
964      ENDDO      ENDDO
965    
# Line 1027  contains Line 985  contains
985      ! Update surface temperature:      ! Update surface temperature:
986    
987      DO i = 1, klon      DO i = 1, klon
988         zxtsol(i) = 0.0         zxtsol(i) = 0.
989         zxfluxlat(i) = 0.0         zxfluxlat(i) = 0.
990    
991         zt2m(i) = 0.0         zt2m(i) = 0.
992         zq2m(i) = 0.0         zq2m(i) = 0.
993         zu10m(i) = 0.0         zu10m(i) = 0.
994         zv10m(i) = 0.0         zv10m(i) = 0.
995         zxffonte(i) = 0.0         zxffonte(i) = 0.
996         zxfqcalving(i) = 0.0         zxfqcalving(i) = 0.
997    
998         s_pblh(i) = 0.0         s_pblh(i) = 0.
999         s_lcl(i) = 0.0         s_lcl(i) = 0.
1000         s_capCL(i) = 0.0         s_capCL(i) = 0.
1001         s_oliqCL(i) = 0.0         s_oliqCL(i) = 0.
1002         s_cteiCL(i) = 0.0         s_cteiCL(i) = 0.
1003         s_pblT(i) = 0.0         s_pblT(i) = 0.
1004         s_therm(i) = 0.0         s_therm(i) = 0.
1005         s_trmb1(i) = 0.0         s_trmb1(i) = 0.
1006         s_trmb2(i) = 0.0         s_trmb2(i) = 0.
1007         s_trmb3(i) = 0.0         s_trmb3(i) = 0.
1008    
1009         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1010              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1011              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  
1012      ENDDO      ENDDO
1013      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1014         DO i = 1, klon         DO i = 1, klon
# Line 1110  contains Line 1065  contains
1065      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1066    
1067      DO i = 1, klon      DO i = 1, klon
1068         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1069      ENDDO      ENDDO
1070    
1071      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1072    
1073      DO k = 1, llm      DO k = 1, llm
1074         DO i = 1, klon         DO i = 1, klon
1075            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1076                 + 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  
1077         ENDDO         ENDDO
1078      ENDDO      ENDDO
1079    
1080      IF (check) THEN      IF (check) THEN
1081         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1082         print *, "avantcon = ", za         print *, "avantcon = ", za
1083      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  
1084    
1085      select case (iflag_con)      if (iflag_con == 2) then
1086      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1087         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
1088              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, &
1089              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), &
1090              pmflxs)              mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
1091                kdtop, pmflxr, pmflxs)
1092         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1093         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1094         DO i = 1, klon         ibas_con = llm + 1 - kcbot
1095            ibas_con(i) = llm + 1 - kcbot(i)         itop_con = llm + 1 - kctop
1096            itop_con(i) = llm + 1 - kctop(i)      else
1097         ENDDO         ! iflag_con >= 3
1098      case (3:)  
1099         ! number of tracers for the convection scheme of Kerry Emanuel:         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1100                v_seri, tr_seri, sig1, w01, d_t_con, d_q_con, &
1101                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1102                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1103                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1104                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1105           ! (number of tracers for the convection scheme of Kerry Emanuel:
1106         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1107         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1108         ! 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  
1109    
1110         IF (.NOT. ok_gust) THEN         clwcon0 = qcondc
1111            do i = 1, klon         mfu = upwd + dnwd
1112               wd(i) = 0.0         IF (.NOT. ok_gust) wd = 0.
           enddo  
        ENDIF  
1113    
1114         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1115    
# Line 1183  contains Line 1118  contains
1118               zx_t = t_seri(i, k)               zx_t = t_seri(i, k)
1119               IF (thermcep) THEN               IF (thermcep) THEN
1120                  zdelta = MAX(0., SIGN(1., rtt-zx_t))                  zdelta = MAX(0., SIGN(1., rtt-zx_t))
1121                  zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)                  zx_qs = r2es * FOEEW(zx_t, zdelta) / play(i, k)
1122                  zx_qs = MIN(0.5, zx_qs)                  zx_qs = MIN(0.5, zx_qs)
1123                  zcor = 1./(1.-retv*zx_qs)                  zcor = 1./(1.-retv*zx_qs)
1124                  zx_qs = zx_qs*zcor                  zx_qs = zx_qs*zcor
# Line 1199  contains Line 1134  contains
1134         ENDDO         ENDDO
1135    
1136         ! calcul des proprietes des nuages convectifs         ! calcul des proprietes des nuages convectifs
1137         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon * clwcon0
1138         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1139              rnebcon0)              rnebcon0)
1140      case default  
1141         print *, "iflag_con non-prevu", iflag_con         mfd = 0.
1142         stop 1         pen_u = 0.
1143      END select         pen_d = 0.
1144           pde_d = 0.
1145           pde_u = 0.
1146        END if
1147    
1148      DO k = 1, llm      DO k = 1, llm
1149         DO i = 1, klon         DO i = 1, klon
# Line 1229  contains Line 1167  contains
1167      IF (check) THEN      IF (check) THEN
1168         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1169         print *, "aprescon = ", za         print *, "aprescon = ", za
1170         zx_t = 0.0         zx_t = 0.
1171         za = 0.0         za = 0.
1172         DO i = 1, klon         DO i = 1, klon
1173            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1174            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
# Line 1239  contains Line 1177  contains
1177         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1178         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1179      ENDIF      ENDIF
1180      IF (zx_ajustq) THEN  
1181         DO i = 1, klon      IF (iflag_con == 2) THEN
1182            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1183         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  
1184         DO k = 1, llm         DO k = 1, llm
1185            DO i = 1, klon            DO i = 1, klon
1186               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 1189  contains
1189            ENDDO            ENDDO
1190         ENDDO         ENDDO
1191      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1192    
1193      ! Convection sèche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1194    
# Line 1292  contains Line 1219  contains
1219    
1220      ! Caclul des ratqs      ! Caclul des ratqs
1221    
1222      ! 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
1223      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1224      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1225         do k = 1, llm         do k = 1, llm
1226            do i = 1, klon            do i = 1, klon
1227               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1228                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1229                       +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)
1230               else               else
1231                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1232               endif               endif
# Line 1310  contains Line 1237  contains
1237      ! ratqs stables      ! ratqs stables
1238      do k = 1, llm      do k = 1, llm
1239         do i = 1, klon         do i = 1, klon
1240            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1241                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1242         enddo         enddo
1243      enddo      enddo
1244    
1245      ! ratqs final      ! ratqs final
1246      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1247         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1248         ! ratqs final         ! ratqs final
1249         ! 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
1250         ! relaxation des ratqs         ! relaxation des ratqs
1251         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1252         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1253      else      else
1254         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
1255         ratqs = ratqss         ratqs = ratqss
1256      endif      endif
1257    
     ! Processus de condensation à grande echelle et processus de  
     ! précipitation :  
1258      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &
1259           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, &
1260           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 1274  contains
1274      IF (check) THEN      IF (check) THEN
1275         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1276         print *, "apresilp = ", za         print *, "apresilp = ", za
1277         zx_t = 0.0         zx_t = 0.
1278         za = 0.0         za = 0.
1279         DO i = 1, klon         DO i = 1, klon
1280            za = za + airephy(i)/REAL(klon)            za = za + airephy(i)/REAL(klon)
1281            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
# Line 1393  contains Line 1317  contains
1317         endif         endif
1318    
1319         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1320         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1321              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1322         DO k = 1, llm         DO k = 1, llm
1323            DO i = 1, klon            DO i = 1, klon
1324               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1405  contains Line 1328  contains
1328            ENDDO            ENDDO
1329         ENDDO         ENDDO
1330      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1331         ! On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le maximum du calcul de
1332         ! 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é
1333         ! facttemps         ! d'un facteur facttemps.
1334         facteur = dtphys *facttemps         facteur = dtphys * facttemps
1335         do k = 1, llm         do k = 1, llm
1336            do i = 1, klon            do i = 1, klon
1337               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1338               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k) * clwcon0(i, k) &
1339                    then                    > rnebcon(i, k) * clwcon(i, k)) then
1340                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
1341                  clwcon(i, k) = clwcon0(i, k)                  clwcon(i, k) = clwcon0(i, k)
1342               endif               endif
# Line 1472  contains Line 1395  contains
1395      ENDDO      ENDDO
1396    
1397      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003  
1398      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1399         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1400         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1401         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1402    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1403         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, &
1404              aerindex)              aerindex)
1405      ELSE      ELSE
# Line 1489  contains Line 1410  contains
1410    
1411      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
1412      if (ok_newmicro) then      if (ok_newmicro) then
1413         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1414              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1415              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1416      else      else
1417         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1418              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 1462  contains
1462    
1463      ! Calculer l'hydrologie de la surface      ! Calculer l'hydrologie de la surface
1464      DO i = 1, klon      DO i = 1, klon
1465         zxqsurf(i) = 0.0         zxqsurf(i) = 0.
1466         zxsnow(i) = 0.0         zxsnow(i) = 0.
1467      ENDDO      ENDDO
1468      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1469         DO i = 1, klon         DO i = 1, klon
# Line 1565  contains Line 1485  contains
1485         igwd = 0         igwd = 0
1486         DO i = 1, klon         DO i = 1, klon
1487            itest(i) = 0            itest(i) = 0
1488            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.0)) THEN            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN
1489               itest(i) = 1               itest(i) = 1
1490               igwd = igwd + 1               igwd = igwd + 1
1491               idx(igwd) = i               idx(igwd) = i
# Line 1636  contains Line 1556  contains
1556    
1557      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1558      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &      call phytrac(rnpb, itap, lmt_pas, julien, time, firstcal, lafin, nqmx-2, &
1559           dtphys, u, t, paprs, play, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &           dtphys, u, t, paprs, play, mfu, mfd, pen_u, pde_u, pen_d, pde_d, &
1560           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, &
1561           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &           frac_nucl, pphis, albsol, rhcl, cldfra, rneb, diafra, cldliq, &
1562           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)           pmflxr, pmflxs, prfl, psfl, da, phi, mp, upwd, dnwd, tr_seri, zmasse)
1563    
1564      IF (offline) THEN      IF (offline) THEN
1565         call phystokenc(dtphys, rlon, rlat, t, pmfu, pmfd, pen_u, pde_u, &         call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, pde_u, &
1566              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &              pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1567              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)              pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1568      ENDIF      ENDIF
# Line 1688  contains Line 1608  contains
1608    
1609      ! SORTIES      ! SORTIES
1610    
1611      !cc prw = eau precipitable      ! prw = eau precipitable
1612      DO i = 1, klon      DO i = 1, klon
1613         prw(i) = 0.         prw(i) = 0.
1614         DO k = 1, llm         DO k = 1, llm
# Line 1736  contains Line 1656  contains
1656         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1657         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &
1658              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &
1659              rain_fall, snow_fall, solsw, sollwdown, dlw, radsol, frugs, &              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &
1660              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &
1661              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1662      ENDIF      ENDIF
1663    
1664      firstcal = .FALSE.      firstcal = .FALSE.

Legend:
Removed from v.62  
changed lines
  Added in v.76

  ViewVC Help
Powered by ViewVC 1.1.21