/[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/phylmd/physiq.f revision 101 by guez, Mon Jul 7 17:45:21 2014 UTC trunk/Sources/phylmd/physiq.f revision 182 by guez, Wed Mar 16 11:11:27 2016 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)         qx, omega, d_u, d_v, d_t, d_qx)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (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    
# Line 19  contains Line 19  contains
19      use aeropt_m, only: aeropt      use aeropt_m, only: aeropt
20      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
21      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_hf, ecrit_ins, ecrit_mth, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, conv_emanuel, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf           ok_orodr, ok_orolf
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
29        USE comgeomphy, ONLY: airephy
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, day_step, iphysiq
32      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
33      use conflx_m, only: conflx      use conflx_m, only: conflx
34      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
# Line 38  contains Line 39  contains
39      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
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 dynetat0_m, only: day_ref, annee_ref
43      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
44      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
45      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
46      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &      USE indicesol, ONLY: clnsurf, epsfra, is_lic, is_oce, is_sic, is_ter, &
47           nbsrf           nbsrf
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49        use netcdf95, only: NF95_CLOSE
50      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
51        use nuage_m, only: nuage
52      USE orbite_m, ONLY: orbite      USE orbite_m, ONLY: orbite
53      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
54      USE phyetat0_m, ONLY: phyetat0, rlat, rlon      USE phyetat0_m, ONLY: phyetat0, rlat, rlon
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56        USE phyredem0_m, ONLY: phyredem0
57      USE phystokenc_m, ONLY: phystokenc      USE phystokenc_m, ONLY: phystokenc
58      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
59      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
60      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
61      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
62      use sugwd_m, only: sugwd      use readsulfate_preind_m, only: readsulfate_preind
63      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use yoegwd, only: sugwd
64      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt
65        use transp_m, only: transp
66        use transp_lay_m, only: transp_lay
67      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
68      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
69      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 64  contains Line 71  contains
71    
72      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
73    
74      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
75      ! (elapsed time since January 1st 0h of the starting year, in days)      ! current day number, based at value 1 on January 1st of annee_ref
76    
77      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
78    
79      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
80      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 111  contains Line 117  contains
117      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
118      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
119    
     ! "slab" ocean  
     REAL, save:: tslab(klon) ! temperature of ocean slab  
     REAL, save:: seaice(klon) ! glace de mer (kg/m2)  
     REAL fluxo(klon) ! flux turbulents ocean-glace de mer  
     REAL fluxg(klon) ! flux turbulents ocean-atmosphere  
   
120      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
121      ! sorties journalieres, mensuelles et instantanees dans les      ! sorties journalieres, mensuelles et instantanees dans les
122      ! fichiers histday, histmth et histins      ! fichiers histday, histmth et histins
# Line 153  contains Line 153  contains
153    
154      integer nlevSTD      integer nlevSTD
155      PARAMETER(nlevSTD = 17)      PARAMETER(nlevSTD = 17)
     real rlevSTD(nlevSTD)  
     DATA rlevSTD/100000., 92500., 85000., 70000., &  
          60000., 50000., 40000., 30000., 25000., 20000., &  
          15000., 10000., 7000., 5000., 3000., 2000., 1000./  
     CHARACTER(LEN = 4) clevSTD(nlevSTD)  
     DATA clevSTD/'1000', '925 ', '850 ', '700 ', '600 ', &  
          '500 ', '400 ', '300 ', '250 ', '200 ', '150 ', '100 ', &  
          '70 ', '50 ', '30 ', '20 ', '10 '/  
156    
157      ! prw: precipitable water      ! prw: precipitable water
158      real prw(klon)      real prw(klon)
# Line 173  contains Line 165  contains
165      INTEGER kmax, lmax      INTEGER kmax, lmax
166      PARAMETER(kmax = 8, lmax = 8)      PARAMETER(kmax = 8, lmax = 8)
167      INTEGER kmaxm1, lmaxm1      INTEGER kmaxm1, lmaxm1
168      PARAMETER(kmaxm1 = kmax-1, lmaxm1 = lmax-1)      PARAMETER(kmaxm1 = kmax - 1, lmaxm1 = lmax - 1)
   
     REAL zx_tau(kmaxm1), zx_pc(lmaxm1)  
     DATA zx_tau/0., 0.3, 1.3, 3.6, 9.4, 23., 60./  
     DATA zx_pc/50., 180., 310., 440., 560., 680., 800./  
   
     ! cldtopres pression au sommet des nuages  
     REAL cldtopres(lmaxm1)  
     DATA cldtopres/50., 180., 310., 440., 560., 680., 800./  
   
     ! taulev: numero du niveau de tau dans les sorties ISCCP  
     CHARACTER(LEN = 4) taulev(kmaxm1)  
   
     DATA taulev/'tau0', 'tau1', 'tau2', 'tau3', 'tau4', 'tau5', 'tau6'/  
     CHARACTER(LEN = 3) pclev(lmaxm1)  
     DATA pclev/'pc1', 'pc2', 'pc3', 'pc4', 'pc5', 'pc6', 'pc7'/  
   
     CHARACTER(LEN = 28) cnameisccp(lmaxm1, kmaxm1)  
     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 'pc= 50-180hPa, tau< 0.3', &  
          'pc= 180-310hPa, tau< 0.3', 'pc= 310-440hPa, tau< 0.3', &  
          'pc= 440-560hPa, tau< 0.3', 'pc= 560-680hPa, tau< 0.3', &  
          'pc= 680-800hPa, tau< 0.3', 'pc< 50hPa, tau= 0.3-1.3', &  
          'pc= 50-180hPa, tau= 0.3-1.3', 'pc= 180-310hPa, tau= 0.3-1.3', &  
          'pc= 310-440hPa, tau= 0.3-1.3', 'pc= 440-560hPa, tau= 0.3-1.3', &  
          'pc= 560-680hPa, tau= 0.3-1.3', 'pc= 680-800hPa, tau= 0.3-1.3', &  
          'pc< 50hPa, tau= 1.3-3.6', 'pc= 50-180hPa, tau= 1.3-3.6', &  
          'pc= 180-310hPa, tau= 1.3-3.6', 'pc= 310-440hPa, tau= 1.3-3.6', &  
          'pc= 440-560hPa, tau= 1.3-3.6', 'pc= 560-680hPa, tau= 1.3-3.6', &  
          'pc= 680-800hPa, tau= 1.3-3.6', 'pc< 50hPa, tau= 3.6-9.4', &  
          'pc= 50-180hPa, tau= 3.6-9.4', 'pc= 180-310hPa, tau= 3.6-9.4', &  
          'pc= 310-440hPa, tau= 3.6-9.4', 'pc= 440-560hPa, tau= 3.6-9.4', &  
          'pc= 560-680hPa, tau= 3.6-9.4', 'pc= 680-800hPa, tau= 3.6-9.4', &  
          'pc< 50hPa, tau= 9.4-23', 'pc= 50-180hPa, tau= 9.4-23', &  
          'pc= 180-310hPa, tau= 9.4-23', 'pc= 310-440hPa, tau= 9.4-23', &  
          'pc= 440-560hPa, tau= 9.4-23', 'pc= 560-680hPa, tau= 9.4-23', &  
          'pc= 680-800hPa, tau= 9.4-23', 'pc< 50hPa, tau= 23-60', &  
          'pc= 50-180hPa, tau= 23-60', 'pc= 180-310hPa, tau= 23-60', &  
          'pc= 310-440hPa, tau= 23-60', 'pc= 440-560hPa, tau= 23-60', &  
          'pc= 560-680hPa, tau= 23-60', 'pc= 680-800hPa, tau= 23-60', &  
          'pc< 50hPa, tau> 60.', 'pc= 50-180hPa, tau> 60.', &  
          'pc= 180-310hPa, tau> 60.', 'pc= 310-440hPa, tau> 60.', &  
          'pc= 440-560hPa, tau> 60.', 'pc= 560-680hPa, tau> 60.', &  
          'pc= 680-800hPa, tau> 60.'/  
   
     ! ISCCP simulator v3.4  
169    
170      ! Variables propres a la physique      ! Variables propres a la physique
171    
172      INTEGER, save:: radpas      INTEGER, save:: radpas
173      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
174      ! "physiq".)      ! "physiq".
175    
176      REAL radsol(klon)      REAL radsol(klon)
177      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
178    
179      INTEGER, SAVE:: itap ! number of calls to "physiq"      INTEGER:: itap = 0 ! number of calls to "physiq"
180    
181      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction      REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction
182    
# Line 246  contains Line 194  contains
194      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
195    
196      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
197      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface  
198    
199      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
200      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 258  contains Line 205  contains
205      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
206      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
207      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
208      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
209        INTEGER igwd, itest(klon)
     INTEGER igwd, idx(klon), itest(klon)  
210    
211      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
212      SAVE agesno ! age de la neige      SAVE agesno ! age de la neige
# Line 278  contains Line 223  contains
223      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
224      REAL, save:: wd(klon)      REAL, save:: wd(klon)
225    
226      ! Variables locales pour la couche limite (al1):      ! Variables pour la couche limite (al1):
   
     ! Variables locales:  
227    
228      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
229      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
# Line 317  contains Line 260  contains
260      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
261      SAVE dlw      SAVE dlw
262      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
263      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
264      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
265      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
266      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 333  contains Line 275  contains
275      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
276      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
277      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
278      REAL, save:: albsol(klon) ! albedo du sol total      REAL, save:: albsol(klon) ! albedo du sol total visible
     REAL, save:: albsollw(klon) ! albedo du sol total  
279      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU      REAL, SAVE:: wo(klon, llm) ! column density of ozone in a cell, in kDU
280    
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
   
281      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
282      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
283    
# Line 368  contains Line 302  contains
302      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
303      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
304      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
305      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
306      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
307      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
308      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
309      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
310      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
311      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
312      REAL albpla(klon)      REAL, save:: albpla(klon)
313      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
314      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     SAVE albpla  
     SAVE heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
315    
316      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
317      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 392  contains Line 321  contains
321    
322      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
323    
324      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
325      real zlongi      real longi
326      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
327      REAL za, zb      REAL za, zb
328      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
329      real zqsat(klon, llm)      real zqsat(klon, llm)
330      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
331      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
332      REAL zphi(klon, llm)      REAL zphi(klon, llm)
333    
334      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. AM Variables pour la CLA (hbtm2)
335    
336      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
337      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
# Line 420  contains Line 349  contains
349      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)
350      REAL s_trmb3(klon)      REAL s_trmb3(klon)
351    
352      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
353    
354      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
355      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
# Line 454  contains Line 383  contains
383      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
384    
385      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon), rain_lsc(klon)
386      REAL snow_con(klon), snow_lsc(klon)      REAL, save:: snow_con(klon)
387        real snow_lsc(klon)
388      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
389    
390      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
# Line 478  contains Line 408  contains
408      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
409      logical ptconv(klon, llm)      logical ptconv(klon, llm)
410    
411      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
412    
413      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
414      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 501  contains Line 431  contains
431      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
432      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
433    
     REAL zsto  
434      real date0      real date0
435    
436      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
# Line 526  contains Line 455  contains
455      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
456    
457      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
458      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value      ! SO4 aerosol concentration, in \mu g/m3, pre-industrial value
459    
460      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
461      ! cloud optical thickness for pre-industrial (pi) aerosols      ! cloud optical thickness for pre-industrial (pi) aerosols
# Line 558  contains Line 487  contains
487      SAVE ffonte      SAVE ffonte
488      SAVE fqcalving      SAVE fqcalving
489      SAVE rain_con      SAVE rain_con
     SAVE snow_con  
490      SAVE topswai      SAVE topswai
491      SAVE topswad      SAVE topswad
492      SAVE solswai      SAVE solswai
# Line 570  contains Line 498  contains
498      ! (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)
499    
500      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
501        integer, save:: ncid_startphy, itau_phy
502    
503      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
504           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
# Line 579  contains Line 508  contains
508    
509      IF (if_ebil >= 1) zero_v = 0.      IF (if_ebil >= 1) zero_v = 0.
510      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
511           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
512    
513      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
514         ! initialiser         ! initialiser
# Line 630  contains Line 559  contains
559         ! Initialiser les compteurs:         ! Initialiser les compteurs:
560    
561         frugs = 0.         frugs = 0.
562         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
563         itaprad = 0              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
564         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
565              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
566              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              run_off_lic_0, sig1, w01, ncid_startphy, itau_phy)
             zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0, sig1, w01)  
567    
568         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
569         q2 = 1e-8         q2 = 1e-8
570    
571         radpas = NINT(86400. / dtphys / nbapp_rad)         lmt_pas = day_step / iphysiq
572           print *, 'Number of time steps of "physics" per day: ', lmt_pas
573    
574         ! on remet le calendrier a zero         radpas = lmt_pas / nbapp_rad
575    
576           ! On remet le calendrier a zero
577         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
578    
        PRINT *, 'cycle_diurne = ', cycle_diurne  
579         CALL printflag(radpas, ok_journe, ok_instan, ok_region)         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
580    
        IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
581         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
582         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
583            ibas_con = 1            ibas_con = 1
584            itop_con = 1            itop_con = 1
585         ENDIF         ENDIF
# Line 668  contains Line 591  contains
591            rugoro = 0.            rugoro = 0.
592         ENDIF         ENDIF
593    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
594         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
595         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
596         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
# Line 679  contains Line 599  contains
599    
600         ! Initialisation des sorties         ! Initialisation des sorties
601    
602         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins, itau_phy)
603         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
604         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
605         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
606           CALL phyredem0(lmt_pas, itau_phy)
607      ENDIF test_firstcal      ENDIF test_firstcal
608    
609      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
# Line 692  contains Line 613  contains
613      v_seri = v      v_seri = v
614      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
615      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
616      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
617    
618      ztsol = sum(ftsol * pctsrf, dim = 2)      ztsol = sum(ftsol * pctsrf, dim = 2)
619    
# Line 740  contains Line 661  contains
661    
662      ! Incrémenter le compteur de la physique      ! Incrémenter le compteur de la physique
663      itap = itap + 1      itap = itap + 1
664      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
665      if (julien == 0) julien = 360      if (julien == 0) julien = 360
666    
667      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
668    
669      ! Prescrire l'ozone :      ! Prescrire l'ozone :
670      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 770  contains Line 691  contains
691      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
692      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
693    
694      ! Calculs nécessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
695        ! la surface.
696    
697      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
698      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
699         CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
700      ELSE      ELSE
701         rmu0 = -999.999         mu0 = - 999.999
702      ENDIF      ENDIF
703    
704      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
705      albsol = sum(falbe * pctsrf, dim = 2)      albsol = sum(falbe * pctsrf, dim = 2)
     albsollw = sum(falblw * pctsrf, dim = 2)  
706    
707      ! R\'epartition sous maille des flux longwave et shortwave      ! R\'epartition sous maille des flux longwave et shortwave
708      ! R\'epartition du longwave par sous-surface lin\'earis\'ee      ! R\'epartition du longwave par sous-surface lin\'earis\'ee
# Line 797  contains Line 718  contains
718      ! Couche limite:      ! Couche limite:
719    
720      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
721           v_seri, julien, rmu0, co2_ppm, ftsol, cdmmax, cdhmax, &           v_seri, julien, mu0, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
722           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
723           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &           fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, frugs, &
724           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &           firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
725           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
726           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
727           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
728           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)           run_off_lic_0)
729    
730      ! Incr\'ementation des flux      ! Incr\'ementation des flux
731    
# Line 931  contains Line 852  contains
852         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
853      ENDDO      ENDDO
854    
     ! Appeler la convection (au choix)  
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k) / dtphys  
           conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k) / dtphys  
        ENDDO  
     ENDDO  
   
855      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
856    
857      if (iflag_con == 2) then      ! Appeler la convection (au choix)
        z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)  
        CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &  
             q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &  
             d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:-1), &  
             mfd(:, llm:1:-1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &  
             kdtop, pmflxr, pmflxs)  
        WHERE (rain_con < 0.) rain_con = 0.  
        WHERE (snow_con < 0.) snow_con = 0.  
        ibas_con = llm + 1 - kcbot  
        itop_con = llm + 1 - kctop  
     else  
        ! iflag_con >= 3  
858    
859        if (conv_emanuel) then
860         da = 0.         da = 0.
861         mp = 0.         mp = 0.
862         phi = 0.         phi = 0.
863         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
864              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
865              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
866              qcondc, wd, pmflxr, pmflxs, da, phi, mp)              qcondc, wd, pmflxr, da, phi, mp)
867         clwcon0 = qcondc         clwcon0 = qcondc
868         mfu = upwd + dnwd         mfu = upwd + dnwd
869         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
870    
871         ! Calcul des propri\'et\'es des nuages convectifs         IF (thermcep) THEN
872              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
873         DO k = 1, llm            zqsat = zqsat / (1. - retv * zqsat)
874            DO i = 1, klon         ELSE
875               IF (thermcep) THEN            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
876                  zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k)))         ENDIF
                 zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k)  
                 zqsat(i, k) = MIN(0.5, zqsat(i, k))  
                 zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k))  
              ELSE  
                 IF (t_seri(i, k) < t_coup) THEN  
                    zqsat(i, k) = qsats(t_seri(i, k))/play(i, k)  
                 ELSE  
                    zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k)  
                 ENDIF  
              ENDIF  
           ENDDO  
        ENDDO  
877    
878         ! calcul des proprietes des nuages convectifs         ! Properties of convective clouds
879         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
880         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
881              rnebcon0)              rnebcon0)
# Line 996  contains Line 885  contains
885         pen_d = 0.         pen_d = 0.
886         pde_d = 0.         pde_d = 0.
887         pde_u = 0.         pde_u = 0.
888        else
889           conv_q = d_q_dyn + d_q_vdf / dtphys
890           conv_t = d_t_dyn + d_t_vdf / dtphys
891           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
892           CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:- 1), &
893                q_seri(:, llm:1:- 1), conv_t, conv_q, zxfluxq(:, 1), omega, &
894                d_t_con, d_q_con, rain_con, snow_con, mfu(:, llm:1:- 1), &
895                mfd(:, llm:1:- 1), pen_u, pde_u, pen_d, pde_d, kcbot, kctop, &
896                kdtop, pmflxr, pmflxs)
897           WHERE (rain_con < 0.) rain_con = 0.
898           WHERE (snow_con < 0.) snow_con = 0.
899           ibas_con = llm + 1 - kcbot
900           itop_con = llm + 1 - kctop
901      END if      END if
902    
903      DO k = 1, llm      DO k = 1, llm
# Line 1029  contains Line 931  contains
931         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
932      ENDIF      ENDIF
933    
934      IF (iflag_con == 2) THEN      IF (.not. conv_emanuel) THEN
935         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
936         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
937         DO k = 1, llm         DO k = 1, llm
# Line 1147  contains Line 1049  contains
1049    
1050      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
1051    
1052      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
1053         ! seulement pour Tiedtke         ! seulement pour Tiedtke
1054         snow_tiedtke = 0.         snow_tiedtke = 0.
1055         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
1056            rain_tiedtke = rain_con            rain_tiedtke = rain_con
1057         else         else
1058            rain_tiedtke = 0.            rain_tiedtke = 0.
1059            do k = 1, llm            do k = 1, llm
1060               do i = 1, klon               do i = 1, klon
1061                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
1062                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k)/dtphys &
1063                          *zmasse(i, k)                          *zmasse(i, k)
1064                  endif                  endif
1065               enddo               enddo
# Line 1225  contains Line 1127  contains
1127         DO i = 1, klon         DO i = 1, klon
1128            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1129            IF (thermcep) THEN            IF (thermcep) THEN
1130               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
              zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)  
1131               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1132               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1. - retv*zx_qs)
1133               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
1134            ELSE            ELSE
1135               IF (zx_t < t_coup) THEN               IF (zx_t < t_coup) THEN
# Line 1245  contains Line 1146  contains
1146      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
1147      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1148         ! Get sulfate aerosol distribution :         ! Get sulfate aerosol distribution :
1149         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1150         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1151    
1152         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, &
1153              aerindex)              aerindex)
# Line 1268  contains Line 1169  contains
1169              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1170      endif      endif
1171    
1172      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
1173      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1174         DO i = 1, klon         ! Calcul de l'abedo moyen par maille
1175            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         albsol = sum(falbe * pctsrf, dim = 2)
1176                 + falbe(i, is_lic) * pctsrf(i, is_lic) &  
                + falbe(i, is_ter) * pctsrf(i, is_ter) &  
                + falbe(i, is_sic) * pctsrf(i, is_sic)  
           albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &  
                + falblw(i, is_lic) * pctsrf(i, is_lic) &  
                + falblw(i, is_ter) * pctsrf(i, is_ter) &  
                + falblw(i, is_sic) * pctsrf(i, is_sic)  
        ENDDO  
1177         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1178         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, t_seri, &
1179              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
1180              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
1181              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
1182              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, cg_ae, topswad, &
1183              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1184      ENDIF      ENDIF
     itaprad = itaprad + 1  
1185    
1186      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1187    
1188      DO k = 1, llm      DO k = 1, llm
1189         DO i = 1, klon         DO i = 1, klon
1190            t_seri(i, k) = t_seri(i, k) + (heat(i, k)-cool(i, k)) * dtphys/86400.            t_seri(i, k) = t_seri(i, k) + (heat(i, k) - cool(i, k)) * dtphys/86400.
1191         ENDDO         ENDDO
1192      ENDDO      ENDDO
1193    
# Line 1328  contains Line 1220  contains
1220      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
1221    
1222      IF (ok_orodr) THEN      IF (ok_orodr) THEN
1223         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
1224         igwd = 0         igwd = 0
1225         DO i = 1, klon         DO i = 1, klon
1226            itest(i) = 0            itest(i) = 0
1227            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
1228               itest(i) = 1               itest(i) = 1
1229               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1230            ENDIF            ENDIF
1231         ENDDO         ENDDO
1232    
1233         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1234              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1235              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1236    
1237         ! ajout des tendances         ! ajout des tendances
1238         DO k = 1, llm         DO k = 1, llm
# Line 1358  contains Line 1249  contains
1249         igwd = 0         igwd = 0
1250         DO i = 1, klon         DO i = 1, klon
1251            itest(i) = 0            itest(i) = 0
1252            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
1253               itest(i) = 1               itest(i) = 1
1254               igwd = igwd + 1               igwd = igwd + 1
              idx(igwd) = i  
1255            ENDIF            ENDIF
1256         ENDDO         ENDDO
1257    
# Line 1394  contains Line 1284  contains
1284         ENDDO         ENDDO
1285      ENDDO      ENDDO
1286    
1287      CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &      CALL aaam_bud(rg, romega, rlat, rlon, pphis, zustrdr, zustrli, zustrph, &
1288           zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)           zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)
1289    
1290      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &      IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &
1291           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &           2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &
1292           d_qt, d_ec)           d_qt, d_ec)
1293    
1294      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1295      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1296           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1297           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, &
1298           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &           dnwd, tr_seri, zmasse, ncid_startphy, nid_ins, itau_phy)
          mp, upwd, dnwd, tr_seri, zmasse)  
1299    
1300      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1301           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
1302           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)           pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)
1303    
1304      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
1305      CALL transp(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, &      CALL transp(paprs, t_seri, q_seri, u_seri, v_seri, zphi, ve, vq, ue, uq)
          ue, uq)  
1306    
1307      ! diag. bilKP      ! diag. bilKP
1308    
1309      CALL transp_lay(paprs, zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &      CALL transp_lay(paprs, t_seri, q_seri, u_seri, v_seri, zphi, &
1310           ve_lay, vq_lay, ue_lay, uq_lay)           ve_lay, vq_lay, ue_lay, uq_lay)
1311    
1312      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
# Line 1472  contains Line 1360  contains
1360      DO iq = 3, nqmx      DO iq = 3, nqmx
1361         DO k = 1, llm         DO k = 1, llm
1362            DO i = 1, klon            DO i = 1, klon
1363               d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / dtphys               d_qx(i, k, iq) = (tr_seri(i, k, iq - 2) - qx(i, k, iq)) / dtphys
1364            ENDDO            ENDDO
1365         ENDDO         ENDDO
1366      ENDDO      ENDDO
# Line 1485  contains Line 1373  contains
1373         ENDDO         ENDDO
1374      ENDDO      ENDDO
1375    
     ! Ecriture des sorties  
1376      call write_histins      call write_histins
1377    
1378      ! Si c'est la fin, il faut conserver l'etat de redemarrage      IF (lafin) then
1379      IF (lafin) THEN         call NF95_CLOSE(ncid_startphy)
1380         itau_phy = itau_phy + itap         CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, &
1381         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &              fsnow, falbe, fevap, rain_fall, snow_fall, solsw, sollw, dlw, &
1382              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1383              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, &
1384              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              w01)
1385              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      end IF
     ENDIF  
1386    
1387      firstcal = .FALSE.      firstcal = .FALSE.
1388    
# Line 1506  contains Line 1392  contains
1392    
1393        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09
1394    
1395          ! Ecriture des sorties
1396    
1397        use dimens_m, only: iim, jjm        use dimens_m, only: iim, jjm
1398        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1399        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
1400    
1401        real zout        integer i, itau_w ! pas de temps ecriture
       integer itau_w ! pas de temps ecriture  
1402        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1403    
1404        !--------------------------------------------------        !--------------------------------------------------
# Line 1519  contains Line 1406  contains
1406        IF (ok_instan) THEN        IF (ok_instan) THEN
1407           ! Champs 2D:           ! Champs 2D:
1408    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1409           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1410    
          i = NINT(zout/zsto)  
1411           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1412           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1413    
          i = NINT(zout/zsto)  
1414           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1415           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1416    
# Line 1597  contains Line 1480  contains
1480           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)
1481           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
1482    
1483           zx_tmp_fi2d(1:klon) = -1*sens(1:klon)           zx_tmp_fi2d(1:klon) = - sens(1:klon)
1484           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)           ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)
1485           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1486           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
# Line 1659  contains Line 1542  contains
1542              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
1543                   zx_tmp_2d)                   zx_tmp_2d)
1544    
1545              zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe(:, nsrf)
1546              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)
1547              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
1548                   zx_tmp_2d)                   zx_tmp_2d)
# Line 1667  contains Line 1550  contains
1550           END DO           END DO
1551           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, zx_tmp_2d)
1552           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)  
1553    
1554           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)
1555           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
# Line 1728  contains Line 1609  contains
1609           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)
1610           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
1611    
1612             CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zx_rh, zx_tmp_3d)
1613             CALL histwrite(nid_ins, "rhum", itau_w, zx_tmp_3d)
1614    
1615           call histsync(nid_ins)           call histsync(nid_ins)
1616        ENDIF        ENDIF
1617    
Legend:
Removed from v.101  
changed lines
  Added in v.182
  ViewVC Help
Powered by ViewVC 1.1.21