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

Diff of /trunk/phylmd/physiq.f90

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

revision 103 by guez, Fri Aug 29 13:00:05 2014 UTC revision 326 by guez, Mon Jun 10 00:29:10 2019 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    
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
     use aeropt_m, only: aeropt  
19      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
21      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, ecrit_ins, ok_instan
22           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin      USE clesphys2, ONLY: conv_emanuel, nbapp_rad, new_oliq, ok_orodr, ok_orolf
23      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE conf_interface_m, ONLY: conf_interface
24           ok_orodr, ok_orolf      USE pbl_surface_m, ONLY: pbl_surface
     USE clmain_m, ONLY: clmain  
25      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
26      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
27        USE comgeomphy, ONLY: airephy
28      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
29      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
31      use conflx_m, only: conflx      use conflx_m, only: conflx
32      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm_m, ONLY: iflag_thermals, ctherm
33      use diagcld2_m, only: diagcld2      use diagcld2_m, only: diagcld2
34      use diagetpq_m, only: diagetpq      USE dimensions, ONLY: llm, nqmx
     use diagphy_m, only: diagphy  
     USE dimens_m, ONLY: llm, nqmx  
35      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
38      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      use dynetat0_chosen_m, only: day_ref, annee_ref
39        USE fcttre, ONLY: foeew
40      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42        USE histsync_m, ONLY: histsync
43        USE histwrite_phy_m, ONLY: histwrite_phy
44      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, &
45           nbsrf           nbsrf
46      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins, nid_ins
47        use lift_noro_m, only: lift_noro
48        use netcdf95, only: NF95_CLOSE
49      use newmicro_m, only: newmicro      use newmicro_m, only: newmicro
50        use nr_util, only: assert
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
55      USE phyredem_m, ONLY: phyredem      USE phyredem_m, ONLY: phyredem
56      USE phystokenc_m, ONLY: phystokenc      USE phyredem0_m, ONLY: phyredem0
57      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
     USE qcheck_m, ONLY: qcheck  
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
59      use readsulfate_m, only: readsulfate      use yoegwd, only: sugwd
60      use sugwd_m, only: sugwd      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt, romega, rsigma, rtt, rmo3, md
61      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      use time_phylmdz, only: itap, increment_itap
62      USE temps, ONLY: annee_ref, day_ref, itau_phy      use transp_m, only: transp
63        use transp_lay_m, only: transp_lay
64      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
65      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
66      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 64  contains Line 68  contains
68    
69      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
70    
71      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
72      ! (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
73    
74      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)  
75    
76      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
77      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 76  contains Line 79  contains
79      REAL, intent(in):: play(:, :) ! (klon, llm)      REAL, intent(in):: play(:, :) ! (klon, llm)
80      ! pression pour le mileu de chaque couche (en Pa)      ! pression pour le mileu de chaque couche (en Pa)
81    
82      REAL, intent(in):: pphi(:, :) ! (klon, llm)      REAL, intent(in):: pphi(:, :) ! (klon, llm)
83      ! géopotentiel de chaque couche (référence sol)      ! géopotentiel de chaque couche (référence sol)
84    
85      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol      REAL, intent(in):: pphis(:) ! (klon) géopotentiel du sol
86    
87      REAL, intent(in):: u(:, :) ! (klon, llm)      REAL, intent(in):: u(:, :) ! (klon, llm)
88      ! vitesse dans la direction X (de O a E) en m/s      ! vitesse dans la direction X (de O a E) en m / s
89    
90      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m/s      REAL, intent(in):: v(:, :) ! (klon, llm) vitesse Y (de S a N) en m / s
91      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)      REAL, intent(in):: t(:, :) ! (klon, llm) temperature (K)
92    
93      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(in):: qx(:, :, :) ! (klon, llm, nqmx)
94      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)      ! (humidit\'e sp\'ecifique et fractions massiques des autres traceurs)
95    
96      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa/s      REAL, intent(in):: omega(:, :) ! (klon, llm) vitesse verticale en Pa / s
97      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)      REAL, intent(out):: d_u(:, :) ! (klon, llm) tendance physique de "u" (m s-2)
98      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)      REAL, intent(out):: d_v(:, :) ! (klon, llm) tendance physique de "v" (m s-2)
99      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K/s)      REAL, intent(out):: d_t(:, :) ! (klon, llm) tendance physique de "t" (K / s)
100    
101      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)      REAL, intent(out):: d_qx(:, :, :) ! (klon, llm, nqmx)
102      ! tendance physique de "qx" (s-1)      ! tendance physique de "qx" (s-1)
# Line 102  contains Line 105  contains
105    
106      LOGICAL:: firstcal = .true.      LOGICAL:: firstcal = .true.
107    
     LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface  
     PARAMETER (ok_gust = .FALSE.)  
   
     LOGICAL, PARAMETER:: check = .FALSE.  
     ! Verifier la conservation du modele en eau  
   
108      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
109      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
110    
111      ! "slab" ocean      ! pour phystoke avec thermiques
     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  
   
     logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.  
     ! sorties journalieres, mensuelles et instantanees dans les  
     ! fichiers histday, histmth et histins  
   
     LOGICAL ok_region ! sortir le fichier regional  
     PARAMETER (ok_region = .FALSE.)  
   
     ! pour phsystoke avec thermiques  
112      REAL fm_therm(klon, llm + 1)      REAL fm_therm(klon, llm + 1)
113      REAL entr_therm(klon, llm)      REAL entr_therm(klon, llm)
114      real, save:: q2(klon, llm + 1, nbsrf)      real, save:: q2(klon, llm + 1, nbsrf)
# Line 135  contains Line 119  contains
119      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)      REAL, save:: t_ancien(klon, llm), q_ancien(klon, llm)
120      LOGICAL, save:: ancien_ok      LOGICAL, save:: ancien_ok
121    
122      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K/s)      REAL d_t_dyn(klon, llm) ! tendance dynamique pour "t" (K / s)
123      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg/kg/s)      REAL d_q_dyn(klon, llm) ! tendance dynamique pour "q" (kg / kg / s)
124    
125      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
126    
127      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)      REAL, save:: swdn0(klon, llm + 1), swdn(klon, llm + 1)
128      REAL swup0(klon, llm + 1), swup(klon, llm + 1)      REAL, save:: swup0(klon, llm + 1), swup(klon, llm + 1)
129      SAVE swdn0, swdn, swup0, swup  
130        REAL, save:: lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
131      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)      REAL, save:: lwup0(klon, llm + 1), lwup(klon, llm + 1)
     REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)  
     SAVE lwdn0, lwdn, lwup0, lwup  
   
     ! Amip2  
     ! variables a une pression donnee  
   
     integer nlevSTD  
     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 '/  
132    
133      ! prw: precipitable water      ! prw: precipitable water
134      real prw(klon)      real prw(klon)
135    
136      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2)      ! flwp, fiwp = Liquid Water Path & Ice Water Path (kg / m2)
137      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)      ! flwc, fiwc = Liquid Water Content & Ice Water Content (kg / kg)
138      REAL flwp(klon), fiwp(klon)      REAL flwp(klon), fiwp(klon)
139      REAL flwc(klon, llm), fiwc(klon, llm)      REAL flwc(klon, llm), fiwc(klon, llm)
140    
     INTEGER kmax, lmax  
     PARAMETER(kmax = 8, lmax = 8)  
     INTEGER kmaxm1, lmaxm1  
     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  
   
141      ! Variables propres a la physique      ! Variables propres a la physique
142    
143      INTEGER, save:: radpas      INTEGER, save:: radpas
144      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
145      ! "physiq".)      ! "physiq".
146    
147      REAL radsol(klon)      REAL, save:: radsol(klon)
148      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      ! Bilan radiatif net au sol (W/m2), positif vers le bas. Must be
149        ! saved because radlwsw is not called at every time step.
150      INTEGER, SAVE:: itap ! number of calls to "physiq"      
151        REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction, in K
     REAL, save:: ftsol(klon, nbsrf) ! skin temperature of surface fraction  
152    
153      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)      REAL, save:: ftsoil(klon, nsoilmx, nbsrf)
154      ! soil temperature of surface fraction      ! soil temperature of surface fraction
155    
156      REAL, save:: fevap(klon, nbsrf) ! evaporation      REAL fluxlat(klon, nbsrf) ! flux de chaleur latente, en W m-2
     REAL fluxlat(klon, nbsrf)  
     SAVE fluxlat  
157    
158      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
159      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
160    
161      REAL, save:: qsol(klon)      REAL, save:: qsol(klon) ! column-density of water in soil, in kg m-2
162      ! column-density of water in soil, in kg m-2      REAL, save:: fsnow(klon, nbsrf) ! \'epaisseur neigeuse
163        REAL, save:: falbe(klon, nbsrf) ! albedo visible par type de surface
     REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse  
     REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface  
     REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface  
164    
165      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :      ! Param\`etres de l'orographie \`a l'\'echelle sous-maille (OESM) :
166      REAL, save:: zmea(klon) ! orographie moyenne      REAL, save:: zmea(klon) ! orographie moyenne
# Line 258  contains Line 171  contains
171      REAL, save:: zpic(klon) ! Maximum de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
172      REAL, save:: zval(klon) ! Minimum de l'OESM      REAL, save:: zval(klon) ! Minimum de l'OESM
173      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
   
174      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
175        INTEGER ktest(klon)
176    
177      INTEGER igwd, idx(klon), itest(klon)      REAL, save:: agesno(klon, nbsrf) ! age de la neige
178        REAL, save:: run_off_lic_0(klon)
     REAL agesno(klon, nbsrf)  
     SAVE agesno ! age de la neige  
179    
180      REAL run_off_lic_0(klon)      ! Variables li\'ees \`a la convection d'Emanuel :
181      SAVE run_off_lic_0      REAL, save:: Ma(klon, llm) ! undilute upward mass flux
     !KE43  
     ! Variables liees a la convection de K. Emanuel (sb):  
   
     REAL Ma(klon, llm) ! undilute upward mass flux  
     SAVE Ma  
     REAL qcondc(klon, llm) ! in-cld water content from convect  
     SAVE qcondc  
182      REAL, save:: sig1(klon, llm), w01(klon, llm)      REAL, save:: sig1(klon, llm), w01(klon, llm)
     REAL, save:: wd(klon)  
   
     ! Variables locales pour la couche limite (al1):  
   
     ! Variables locales:  
183    
184        ! Variables pour la couche limite (Alain Lahellec) :
185      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
186      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
187    
188      ! Pour phytrac :      REAL coefh(klon, 2:llm) ! coef d'echange pour phytrac
189      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac  
190      REAL yu1(klon) ! vents dans la premiere couche U      REAL, save:: ffonte(klon, nbsrf)
191      REAL yv1(klon) ! vents dans la premiere couche V      ! flux thermique utilise pour fondre la neige
192      REAL ffonte(klon, nbsrf) !Flux thermique utilise pour fondre la neige  
193      REAL fqcalving(klon, nbsrf) !Flux d'eau "perdue" par la surface      REAL fqcalving(klon, nbsrf)
194      ! !et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et n\'ecessaire pour limiter
195      ! !hauteur de neige, en kg/m2/s      ! la hauteur de neige, en kg / m2 / s
196      REAL zxffonte(klon), zxfqcalving(klon)  
197        REAL zxffonte(klon)
198      REAL pfrac_impa(klon, llm)! Produits des coefs lessivage impaction  
199      save pfrac_impa      REAL, save:: pfrac_impa(klon, llm)! Produits des coefs lessivage impaction
200      REAL pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation      REAL, save:: pfrac_nucl(klon, llm)! Produits des coefs lessivage nucleation
201      save pfrac_nucl  
202      REAL pfrac_1nucl(klon, llm)! Produits des coefs lessi nucl (alpha = 1)      REAL, save:: pfrac_1nucl(klon, llm)
203      save pfrac_1nucl      ! Produits des coefs lessi nucl (alpha = 1)
204      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)  
205        REAL frac_impa(klon, llm) ! fraction d'a\'erosols lessiv\'es (impaction)
206      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
207    
208      REAL, save:: rain_fall(klon)      REAL, save:: rain_fall(klon)
209      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
210    
211      REAL, save:: snow_fall(klon)      REAL, save:: snow_fall(klon)
212      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
213    
214      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
215    
216      REAL evap(klon), devap(klon) ! evaporation and its derivative      REAL evap(klon) ! flux d'\'evaporation au sol
217      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      real dflux_q(klon) ! derivative of the evaporation flux at the surface
218      REAL dlw(klon) ! derivee infra rouge      REAL sens(klon) ! flux de chaleur sensible au sol
219      SAVE dlw      real dflux_t(klon) ! derivee du flux de chaleur sensible au sol
220        REAL, save:: dlw(klon) ! derivative of infra-red flux
221      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
222      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL fder(klon) ! d\'erive de flux (sensible et latente)
     save fder  
223      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
224      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
225      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 330  contains Line 231  contains
231      ! Conditions aux limites      ! Conditions aux limites
232    
233      INTEGER julien      INTEGER julien
     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day  
234      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
235      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE      REAL, save:: albsol(klon) ! albedo du sol total, visible, moyen par maille
     REAL, save:: albsol(klon) ! albedo du sol total  
     REAL, save:: albsollw(klon) ! albedo du sol total  
236      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
237        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     ! Declaration des procedures appelees  
   
     EXTERNAL nuage ! calculer les proprietes radiatives  
     EXTERNAL transp ! transport total de l'eau et de l'energie  
   
     ! Variables locales  
238    
239      real, save:: clwcon(klon, llm), rnebcon(klon, llm)      real, save:: clwcon(klon, llm), rnebcon(klon, llm)
240      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)      real, save:: clwcon0(klon, llm), rnebcon0(klon, llm)
241    
242      REAL rhcl(klon, llm) ! humiditi relative ciel clair      REAL rhcl(klon, llm) ! humidit\'e relative ciel clair
243      REAL dialiq(klon, llm) ! eau liquide nuageuse      REAL dialiq(klon, llm) ! eau liquide nuageuse
244      REAL diafra(klon, llm) ! fraction nuageuse      REAL diafra(klon, llm) ! fraction nuageuse
245      REAL cldliq(klon, llm) ! eau liquide nuageuse      REAL cldliq(klon, llm) ! eau liquide nuageuse
# Line 355  contains Line 247  contains
247      REAL cldtau(klon, llm) ! epaisseur optique      REAL cldtau(klon, llm) ! epaisseur optique
248      REAL cldemi(klon, llm) ! emissivite infrarouge      REAL cldemi(klon, llm) ! emissivite infrarouge
249    
250      REAL fluxq(klon, llm, nbsrf) ! flux turbulent d'humidite      REAL flux_q(klon, nbsrf) ! flux turbulent d'humidite à la surface
251      REAL fluxt(klon, llm, nbsrf) ! flux turbulent de chaleur  
252      REAL fluxu(klon, llm, nbsrf) ! flux turbulent de vitesse u      REAL flux_t(klon, nbsrf)
253      REAL fluxv(klon, llm, nbsrf) ! flux turbulent de vitesse v      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
254        ! vers le bas) à la surface
255      REAL zxfluxt(klon, llm)  
256      REAL zxfluxq(klon, llm)      REAL flux_u(klon, nbsrf), flux_v(klon, nbsrf)
257      REAL zxfluxu(klon, llm)      ! tension du vent (flux turbulent de vent) à la surface, en Pa
     REAL zxfluxv(klon, llm)  
258    
259      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
260      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
261      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
262      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
263      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
264      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
265      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
     REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface  
     real, save:: sollwdown(klon) ! downward LW flux at surface  
     REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)  
     REAL albpla(klon)  
     REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface  
     REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface  
     SAVE albpla  
     SAVE heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
266    
267      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL, save:: sollw(klon) ! surface net downward longwave flux, in W m-2
268      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      real, save:: sollwdown(klon) ! downwelling longwave flux at surface
269        REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
270        REAL, save:: albpla(klon)
271    
272      REAL cldl(klon), cldm(klon), cldh(klon) !nuages bas, moyen et haut      REAL conv_q(klon, llm) ! convergence de l'humidite (kg / kg / s)
273      REAL cldt(klon), cldq(klon) !nuage total, eau liquide integree      REAL conv_t(klon, llm) ! convergence of temperature (K / s)
274    
275      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL cldl(klon), cldm(klon), cldh(klon) ! nuages bas, moyen et haut
276        REAL cldt(klon), cldq(klon) ! nuage total, eau liquide integree
277    
278      REAL dist, rmu0(klon), fract(klon)      REAL zxfluxlat(klon)
279      real zlongi      REAL dist, mu0(klon), fract(klon)
280        real longi
281      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
282      REAL za, zb      REAL zb
283      REAL zx_t, zx_qs, zcor      REAL zx_qs, zcor
284      real zqsat(klon, llm)      real zqsat(klon, llm)
285      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
     REAL, PARAMETER:: t_coup = 234.  
286      REAL zphi(klon, llm)      REAL zphi(klon, llm)
287    
288      ! cf. AM Variables locales pour la CLA (hbtm2)      ! cf. Anne Mathieu, variables pour la couche limite atmosphérique (hbtm)
289    
290      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite      REAL, SAVE:: pblh(klon, nbsrf) ! Hauteur de couche limite
291      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA      REAL, SAVE:: plcl(klon, nbsrf) ! Niveau de condensation de la CLA
292      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite      REAL, SAVE:: capCL(klon, nbsrf) ! CAPE de couche limite
293      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite      REAL, SAVE:: oliqCL(klon, nbsrf) ! eau_liqu integree de couche limite
294      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite      REAL, SAVE:: cteiCL(klon, nbsrf) ! cloud top instab. crit. couche limite
295      REAL, SAVE:: pblt(klon, nbsrf) ! T a la Hauteur de couche limite      REAL, SAVE:: pblt(klon, nbsrf) ! T \`a la hauteur de couche limite
296      REAL, SAVE:: therm(klon, nbsrf)      REAL, SAVE:: therm(klon, nbsrf)
297      REAL, SAVE:: trmb1(klon, nbsrf) ! deep_cape      ! Grandeurs de sorties
     REAL, SAVE:: trmb2(klon, nbsrf) ! inhibition  
     REAL, SAVE:: trmb3(klon, nbsrf) ! Point Omega  
     ! Grdeurs de sorties  
298      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)      REAL s_pblh(klon), s_lcl(klon), s_capCL(klon)
299      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)      REAL s_oliqCL(klon), s_cteiCL(klon), s_pblt(klon)
300      REAL s_therm(klon), s_trmb1(klon), s_trmb2(klon)      REAL s_therm(klon)
     REAL s_trmb3(klon)  
301    
302      ! Variables locales pour la convection de K. Emanuel :      ! Variables pour la convection de K. Emanuel :
303    
304      REAL upwd(klon, llm) ! saturated updraft mass flux      REAL upwd(klon, llm) ! saturated updraft mass flux
305      REAL dnwd(klon, llm) ! saturated downdraft mass flux      REAL dnwd(klon, llm) ! saturated downdraft mass flux
306      REAL dnwd0(klon, llm) ! unsaturated downdraft mass flux      REAL, save:: cape(klon)
     REAL cape(klon) ! CAPE  
     SAVE cape  
307    
308      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
309    
# Line 438  contains Line 315  contains
315      ! eva: \'evaporation de l'eau liquide nuageuse      ! eva: \'evaporation de l'eau liquide nuageuse
316      ! vdf: vertical diffusion in boundary layer      ! vdf: vertical diffusion in boundary layer
317      REAL d_t_con(klon, llm), d_q_con(klon, llm)      REAL d_t_con(klon, llm), d_q_con(klon, llm)
318      REAL d_u_con(klon, llm), d_v_con(klon, llm)      REAL, save:: d_u_con(klon, llm), d_v_con(klon, llm)
319      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)      REAL d_t_lsc(klon, llm), d_q_lsc(klon, llm), d_ql_lsc(klon, llm)
320      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)      REAL d_t_ajs(klon, llm), d_q_ajs(klon, llm)
321      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)      REAL d_u_ajs(klon, llm), d_v_ajs(klon, llm)
# Line 452  contains Line 329  contains
329      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)      REAL prfl(klon, llm + 1), psfl(klon, llm + 1)
330    
331      INTEGER, save:: ibas_con(klon), itop_con(klon)      INTEGER, save:: ibas_con(klon), itop_con(klon)
332        real ema_pct(klon) ! Emanuel pressure at cloud top, in Pa
333    
334      REAL rain_con(klon), rain_lsc(klon)      REAL rain_con(klon)
335      REAL snow_con(klon), snow_lsc(klon)      real rain_lsc(klon)
336      REAL d_ts(klon, nbsrf)      REAL snow_con(klon) ! neige (mm / s)
337        real snow_lsc(klon)
338        REAL d_ts(klon, nbsrf) ! variation of ftsol
339    
340      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)      REAL d_u_vdf(klon, llm), d_v_vdf(klon, llm)
341      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)      REAL d_t_vdf(klon, llm), d_q_vdf(klon, llm)
# Line 478  contains Line 358  contains
358      integer:: iflag_cldcon = 1      integer:: iflag_cldcon = 1
359      logical ptconv(klon, llm)      logical ptconv(klon, llm)
360    
361      ! Variables locales pour effectuer les appels en s\'erie :      ! Variables pour effectuer les appels en s\'erie :
362    
363      REAL t_seri(klon, llm), q_seri(klon, llm)      REAL t_seri(klon, llm), q_seri(klon, llm)
364      REAL ql_seri(klon, llm)      REAL ql_seri(klon, llm)
# Line 489  contains Line 369  contains
369    
370      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
371      REAL zustrli(klon), zvstrli(klon)      REAL zustrli(klon), zvstrli(klon)
     REAL zustrph(klon), zvstrph(klon)  
372      REAL aam, torsfc      REAL aam, torsfc
373    
     REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique  
   
     INTEGER, SAVE:: nid_ins  
   
374      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
375      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
376      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.
377      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.
378    
379      REAL zsto      REAL tsol(klon)
     real date0  
380    
381      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      REAL d_t_ec(klon, llm)
382      REAL ztsol(klon)      ! tendance due \`a la conversion d'\'energie cin\'etique en
383      REAL d_h_vcol, d_qt, d_ec      ! énergie thermique
384      REAL, SAVE:: d_h_vcol_phy  
385      REAL zero_v(klon)      REAL, save:: t2m(klon, nbsrf), q2m(klon, nbsrf)
386      CHARACTER(LEN = 20) tit      ! temperature and humidity at 2 m
387      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics  
388      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation      REAL, save:: u10m_srf(klon, nbsrf), v10m_srf(klon, nbsrf)
389        ! composantes du vent \`a 10 m
390      REAL d_t_ec(klon, llm) ! tendance due \`a la conversion Ec -> E thermique      
391      REAL ZRCPD      REAL zt2m(klon), zq2m(klon) ! température, humidité 2 m moyenne sur 1 maille
392        REAL u10m(klon), v10m(klon) ! vent \`a 10 m moyenn\' sur les sous-surfaces
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m  
     REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille  
     REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille  
393    
394      ! Aerosol effects:      ! Aerosol effects:
395    
396      REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)      REAL, save:: topswad(klon), solswad(klon) ! aerosol direct effect
   
     REAL, save:: sulfate_pi(klon, llm)  
     ! SO4 aerosol concentration, in micro g/m3, pre-industrial value  
   
     REAL cldtaupi(klon, llm)  
     ! cloud optical thickness for pre-industrial (pi) aerosols  
   
     REAL re(klon, llm) ! Cloud droplet effective radius  
     REAL fl(klon, llm) ! denominator of re  
   
     ! Aerosol optical properties  
     REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)  
     REAL, save:: cg_ae(klon, llm, 2)  
   
     REAL topswad(klon), solswad(klon) ! aerosol direct effect  
     REAL topswai(klon), solswai(klon) ! aerosol indirect effect  
   
     REAL aerindex(klon) ! POLDER aerosol index  
   
397      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
     LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect  
398    
399      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
400      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
401      ! B). They link cloud droplet number concentration to aerosol mass      ! B). They link cloud droplet number concentration to aerosol mass
402      ! concentration.      ! concentration.
403    
404      SAVE u10m      real zmasse(klon, llm)
     SAVE v10m  
     SAVE t2m  
     SAVE q2m  
     SAVE ffonte  
     SAVE fqcalving  
     SAVE rain_con  
     SAVE snow_con  
     SAVE topswai  
     SAVE topswad  
     SAVE solswai  
     SAVE solswad  
     SAVE d_u_con  
     SAVE d_v_con  
   
     real zmasse(klon, llm)  
405      ! (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)
406    
407      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      integer, save:: ncid_startphy
408    
409      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &      namelist /physiq_nml/ fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, &
410           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &           ratqsbas, ratqshaut, ok_ade, bl95_b0, bl95_b1
          ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals  
411    
412      !----------------------------------------------------------------      !----------------------------------------------------------------
413    
     IF (if_ebil >= 1) zero_v = 0.  
414      IF (nqmx < 2) CALL abort_gcm('physiq', &      IF (nqmx < 2) CALL abort_gcm('physiq', &
415           'eaux vapeur et liquide sont indispensables', 1)           'eaux vapeur et liquide sont indispensables')
416    
417      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
418         ! initialiser         ! initialiser
419         u10m = 0.         u10m_srf = 0.
420         v10m = 0.         v10m_srf = 0.
421         t2m = 0.         t2m = 0.
422         q2m = 0.         q2m = 0.
423         ffonte = 0.         ffonte = 0.
        fqcalving = 0.  
        piz_ae = 0.  
        tau_ae = 0.  
        cg_ae = 0.  
        rain_con = 0.  
        snow_con = 0.  
        topswai = 0.  
        topswad = 0.  
        solswai = 0.  
        solswad = 0.  
   
424         d_u_con = 0.         d_u_con = 0.
425         d_v_con = 0.         d_v_con = 0.
426         rnebcon0 = 0.         rnebcon0 = 0.
427         clwcon0 = 0.         clwcon0 = 0.
428         rnebcon = 0.         rnebcon = 0.
429         clwcon = 0.         clwcon = 0.
   
430         pblh =0. ! Hauteur de couche limite         pblh =0. ! Hauteur de couche limite
431         plcl =0. ! Niveau de condensation de la CLA         plcl =0. ! Niveau de condensation de la CLA
432         capCL =0. ! CAPE de couche limite         capCL =0. ! CAPE de couche limite
433         oliqCL =0. ! eau_liqu integree de couche limite         oliqCL =0. ! eau_liqu integree de couche limite
434         cteiCL =0. ! cloud top instab. crit. couche limite         cteiCL =0. ! cloud top instab. crit. couche limite
435         pblt =0. ! T a la Hauteur de couche limite         pblt =0.
436         therm =0.         therm =0.
        trmb1 =0. ! deep_cape  
        trmb2 =0. ! inhibition  
        trmb3 =0. ! Point Omega  
437    
        IF (if_ebil >= 1) d_h_vcol_phy = 0.  
   
        iflag_thermals = 0  
        nsplit_thermals = 1  
438         print *, "Enter namelist 'physiq_nml'."         print *, "Enter namelist 'physiq_nml'."
439         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
440         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
441    
442           call ctherm
443         call conf_phys         call conf_phys
444    
445         ! Initialiser les compteurs:         ! Initialiser les compteurs:
446    
447         frugs = 0.         frugs = 0.
448         itap = 0         CALL phyetat0(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
449         itaprad = 0              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
450         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
451              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, &
452              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              ncid_startphy)
             zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &  
             run_off_lic_0, sig1, w01)  
453    
454         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
455         q2 = 1e-8         q2 = 1e-8
456    
457         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = lmt_pas / nbapp_rad
458           print *, "radpas = ", radpas
        ! on remet le calendrier a zero  
        IF (raz_date) itau_phy = 0  
   
        PRINT *, 'cycle_diurne = ', cycle_diurne  
        CALL printflag(radpas, ok_journe, ok_instan, ok_region)  
   
        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  
459    
460         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
461         IF (iflag_con >= 3) THEN         IF (conv_emanuel) THEN
462            ibas_con = 1            ibas_con = 1
463            itop_con = 1            itop_con = 1
464         ENDIF         ENDIF
# Line 668  contains Line 470  contains
470            rugoro = 0.            rugoro = 0.
471         ENDIF         ENDIF
472    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
        ecrit_ins = NINT(ecrit_ins/dtphys)  
        ecrit_hf = NINT(ecrit_hf/dtphys)  
        ecrit_mth = NINT(ecrit_mth/dtphys)  
        ecrit_tra = NINT(86400.*ecrit_tra/dtphys)  
        ecrit_reg = NINT(ecrit_reg/dtphys)  
   
473         ! Initialisation des sorties         ! Initialisation des sorties
474           call ini_histins(ok_newmicro)
475         call ini_histins(dtphys, ok_instan, nid_ins)         CALL phyredem0
476         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         call conf_interface
        ! Positionner date0 pour initialisation de ORCHIDEE  
        print *, 'physiq date0: ', date0  
477      ENDIF test_firstcal      ENDIF test_firstcal
478    
479      ! 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 483  contains
483      v_seri = v      v_seri = v
484      q_seri = qx(:, :, ivap)      q_seri = qx(:, :, ivap)
485      ql_seri = qx(:, :, iliq)      ql_seri = qx(:, :, iliq)
486      tr_seri = qx(:, :, 3: nqmx)      tr_seri = qx(:, :, 3:nqmx)
   
     ztsol = sum(ftsol * pctsrf, dim = 2)  
487    
488      IF (if_ebil >= 1) THEN      tsol = sum(ftsol * pctsrf, dim = 2)
        tit = 'after dynamics'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajout\'es dans la  
        !  dynamique, la variation d'enthalpie par la dynamique devrait  
        !  \^etre \'egale \`a la variation de la physique au pas de temps  
        !  pr\'ec\'edent.  Donc la somme de ces 2 variations devrait \^etre  
        !  nulle.  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol + d_h_vcol_phy, &  
             d_qt, 0.)  
     END IF  
489    
490      ! Diagnostic de la tendance dynamique :      ! Diagnostic de la tendance dynamique :
491      IF (ancien_ok) THEN      IF (ancien_ok) THEN
# Line 738  contains Line 515  contains
515      ! Check temperatures:      ! Check temperatures:
516      CALL hgardfou(t_seri, ftsol)      CALL hgardfou(t_seri, ftsol)
517    
518      ! Incrémenter le compteur de la physique      call increment_itap
519      itap = itap + 1      julien = MOD(dayvrai, 360)
     julien = MOD(NINT(rdayvrai), 360)  
520      if (julien == 0) julien = 360      if (julien == 0) julien = 360
521    
522      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
523    
     ! Prescrire l'ozone :  
     wo = ozonecm(REAL(julien), paprs)  
   
524      ! \'Evaporation de l'eau liquide nuageuse :      ! \'Evaporation de l'eau liquide nuageuse :
525      DO k = 1, llm      DO k = 1, llm
526         DO i = 1, klon         DO i = 1, klon
# Line 759  contains Line 532  contains
532      ENDDO      ENDDO
533      ql_seri = 0.      ql_seri = 0.
534    
     IF (if_ebil >= 2) THEN  
        tit = 'after reevap'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
535      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
536      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
537    
538      ! Calculs nécessaires au calcul de l'albedo dans l'interface      ! Calculs n\'ecessaires au calcul de l'albedo dans l'interface avec
539        ! la surface.
540    
541      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
542      IF (cycle_diurne) THEN      CALL zenang(longi, time, dtphys * radpas, mu0, fract)
        CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)  
     ELSE  
        rmu0 = -999.999  
     ENDIF  
543    
544      ! Calcul de l'abedo moyen par maille      CALL pbl_surface(pctsrf, t_seri, q_seri, u_seri, v_seri, julien, mu0, &
545      albsol = sum(falbe * pctsrf, dim = 2)           ftsol, cdmmax, cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
546      albsollw = sum(falblw * pctsrf, dim = 2)           falbe, fluxlat, rain_fall, snow_fall, frugs, agesno, rugoro, d_t_vdf, &
547             d_q_vdf, d_u_vdf, d_v_vdf, d_ts, flux_t, flux_q, flux_u, flux_v, &
548      ! R\'epartition sous maille des flux longwave et shortwave           cdragh, cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, &
549      ! R\'epartition du longwave par sous-surface lin\'earis\'ee           v10m_srf, pblh, capCL, oliqCL, cteiCL, pblT, therm, plcl, fqcalving, &
550             ffonte, run_off_lic_0, albsol, sollw, solsw, tsol)
     forall (nsrf = 1: nbsrf)  
        fsollw(:, nsrf) = sollw + 4. * RSIGMA * ztsol**3 &  
             * (ztsol - ftsol(:, nsrf))  
        fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)  
     END forall  
   
     fder = dlw  
   
     ! Couche limite:  
   
     CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &  
          v_seri, julien, rmu0, co2_ppm, ftsol, cdmmax, cdhmax, &  
          ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &  
          fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &  
          fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &  
          d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &  
          q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &  
          capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &  
          fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)  
551    
552      ! Incr\'ementation des flux      ! Incr\'ementation des flux
553    
554      zxfluxt = 0.      sens = sum(flux_t * pctsrf, dim = 2)
555      zxfluxq = 0.      evap = - sum(flux_q * pctsrf, dim = 2)
556      zxfluxu = 0.      fder = dlw + dflux_t + dflux_q
     zxfluxv = 0.  
     DO nsrf = 1, nbsrf  
        DO k = 1, llm  
           DO i = 1, klon  
              zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
           END DO  
        END DO  
     END DO  
     DO i = 1, klon  
        sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol  
        evap(i) = - zxfluxq(i, 1) ! flux d'\'evaporation au sol  
        fder(i) = dlw(i) + dsens(i) + devap(i)  
     ENDDO  
557    
558      DO k = 1, llm      DO k = 1, llm
559         DO i = 1, klon         DO i = 1, klon
# Line 837  contains Line 564  contains
564         ENDDO         ENDDO
565      ENDDO      ENDDO
566    
567      IF (if_ebil >= 2) THEN      call assert(abs(sum(pctsrf, dim = 2) - 1.) <= EPSFRA, 'physiq: pctsrf')
568         tit = 'after clmain'      ftsol = ftsol + d_ts ! update surface temperature
569         CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &      tsol = sum(ftsol * pctsrf, dim = 2)
570              ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)      zxfluxlat = sum(fluxlat * pctsrf, dim = 2)
571         call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &      zt2m = sum(t2m * pctsrf, dim = 2)
572              sens, evap, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)      zq2m = sum(q2m * pctsrf, dim = 2)
573      END IF      u10m = sum(u10m_srf * pctsrf, dim = 2)
574        v10m = sum(v10m_srf * pctsrf, dim = 2)
575      ! Update surface temperature:      zxffonte = sum(ffonte * pctsrf, dim = 2)
576        s_pblh = sum(pblh * pctsrf, dim = 2)
577      DO i = 1, klon      s_lcl = sum(plcl * pctsrf, dim = 2)
578         zxtsol(i) = 0.      s_capCL = sum(capCL * pctsrf, dim = 2)
579         zxfluxlat(i) = 0.      s_oliqCL = sum(oliqCL * pctsrf, dim = 2)
580        s_cteiCL = sum(cteiCL * pctsrf, dim = 2)
581        s_pblT = sum(pblT * pctsrf, dim = 2)
582        s_therm = sum(therm * pctsrf, dim = 2)
583    
584         zt2m(i) = 0.      ! Si une sous-fraction n'existe pas, elle prend la valeur moyenne :
        zq2m(i) = 0.  
        zu10m(i) = 0.  
        zv10m(i) = 0.  
        zxffonte(i) = 0.  
        zxfqcalving(i) = 0.  
   
        s_pblh(i) = 0.  
        s_lcl(i) = 0.  
        s_capCL(i) = 0.  
        s_oliqCL(i) = 0.  
        s_cteiCL(i) = 0.  
        s_pblT(i) = 0.  
        s_therm(i) = 0.  
        s_trmb1(i) = 0.  
        s_trmb2(i) = 0.  
        s_trmb3(i) = 0.  
   
        IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &  
             + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &  
             'physiq : probl\`eme sous surface au point ', i, &  
             pctsrf(i, 1 : nbsrf)  
     ENDDO  
585      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
586         DO i = 1, klon         DO i = 1, klon
587            ftsol(i, nsrf) = ftsol(i, nsrf) + d_ts(i, nsrf)            IF (pctsrf(i, nsrf) < epsfra) then
588            zxtsol(i) = zxtsol(i) + ftsol(i, nsrf)*pctsrf(i, nsrf)               ftsol(i, nsrf) = tsol(i)
589            zxfluxlat(i) = zxfluxlat(i) + fluxlat(i, nsrf)*pctsrf(i, nsrf)               t2m(i, nsrf) = zt2m(i)
590                 q2m(i, nsrf) = zq2m(i)
591            zt2m(i) = zt2m(i) + t2m(i, nsrf)*pctsrf(i, nsrf)               u10m_srf(i, nsrf) = u10m(i)
592            zq2m(i) = zq2m(i) + q2m(i, nsrf)*pctsrf(i, nsrf)               v10m_srf(i, nsrf) = v10m(i)
593            zu10m(i) = zu10m(i) + u10m(i, nsrf)*pctsrf(i, nsrf)               ffonte(i, nsrf) = zxffonte(i)
594            zv10m(i) = zv10m(i) + v10m(i, nsrf)*pctsrf(i, nsrf)               pblh(i, nsrf) = s_pblh(i)
595            zxffonte(i) = zxffonte(i) + ffonte(i, nsrf)*pctsrf(i, nsrf)               plcl(i, nsrf) = s_lcl(i)
596            zxfqcalving(i) = zxfqcalving(i) + &               capCL(i, nsrf) = s_capCL(i)
597                 fqcalving(i, nsrf)*pctsrf(i, nsrf)               oliqCL(i, nsrf) = s_oliqCL(i)
598            s_pblh(i) = s_pblh(i) + pblh(i, nsrf)*pctsrf(i, nsrf)               cteiCL(i, nsrf) = s_cteiCL(i)
599            s_lcl(i) = s_lcl(i) + plcl(i, nsrf)*pctsrf(i, nsrf)               pblT(i, nsrf) = s_pblT(i)
600            s_capCL(i) = s_capCL(i) + capCL(i, nsrf) *pctsrf(i, nsrf)               therm(i, nsrf) = s_therm(i)
601            s_oliqCL(i) = s_oliqCL(i) + oliqCL(i, nsrf) *pctsrf(i, nsrf)            end IF
           s_cteiCL(i) = s_cteiCL(i) + cteiCL(i, nsrf) *pctsrf(i, nsrf)  
           s_pblT(i) = s_pblT(i) + pblT(i, nsrf) *pctsrf(i, nsrf)  
           s_therm(i) = s_therm(i) + therm(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb1(i) = s_trmb1(i) + trmb1(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb2(i) = s_trmb2(i) + trmb2(i, nsrf) *pctsrf(i, nsrf)  
           s_trmb3(i) = s_trmb3(i) + trmb3(i, nsrf) *pctsrf(i, nsrf)  
602         ENDDO         ENDDO
603      ENDDO      ENDDO
604    
605      ! Si une sous-fraction n'existe pas, elle prend la température moyenne :      dlw = - 4. * RSIGMA * tsol**3
606      DO nsrf = 1, nbsrf  
607         DO i = 1, klon      ! Appeler la convection
608            IF (pctsrf(i, nsrf) < epsfra) ftsol(i, nsrf) = zxtsol(i)  
609        if (conv_emanuel) then
610            IF (pctsrf(i, nsrf) < epsfra) t2m(i, nsrf) = zt2m(i)         CALL concvl(paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, w01, &
611            IF (pctsrf(i, nsrf) < epsfra) q2m(i, nsrf) = zq2m(i)              d_t_con, d_q_con, d_u_con, d_v_con, rain_con, ibas_con, itop_con, &
612            IF (pctsrf(i, nsrf) < epsfra) u10m(i, nsrf) = zu10m(i)              upwd, dnwd, Ma, cape, iflagctrl, clwcon0, pmflxr, da, phi, mp)
613            IF (pctsrf(i, nsrf) < epsfra) v10m(i, nsrf) = zv10m(i)         snow_con = 0.
           IF (pctsrf(i, nsrf) < epsfra) ffonte(i, nsrf) = zxffonte(i)  
           IF (pctsrf(i, nsrf) < epsfra) &  
                fqcalving(i, nsrf) = zxfqcalving(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblh(i, nsrf) = s_pblh(i)  
           IF (pctsrf(i, nsrf) < epsfra) plcl(i, nsrf) = s_lcl(i)  
           IF (pctsrf(i, nsrf) < epsfra) capCL(i, nsrf) = s_capCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) oliqCL(i, nsrf) = s_oliqCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) cteiCL(i, nsrf) = s_cteiCL(i)  
           IF (pctsrf(i, nsrf) < epsfra) pblT(i, nsrf) = s_pblT(i)  
           IF (pctsrf(i, nsrf) < epsfra) therm(i, nsrf) = s_therm(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb1(i, nsrf) = s_trmb1(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb2(i, nsrf) = s_trmb2(i)  
           IF (pctsrf(i, nsrf) < epsfra) trmb3(i, nsrf) = s_trmb3(i)  
        ENDDO  
     ENDDO  
   
     ! Calculer la dérive du flux infrarouge  
   
     DO i = 1, klon  
        dlw(i) = - 4. * RSIGMA * zxtsol(i)**3  
     ENDDO  
   
     IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)  
   
     ! Appeler la convection (au choix)  
   
     if (iflag_con == 2) then  
        conv_q = d_q_dyn + d_q_vdf / dtphys  
        conv_t = d_t_dyn + d_t_vdf / dtphys  
        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  
   
        da = 0.  
        mp = 0.  
        phi = 0.  
        CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &  
             w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &  
             ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &  
             qcondc, wd, pmflxr, pmflxs, da, phi, mp)  
        clwcon0 = qcondc  
614         mfu = upwd + dnwd         mfu = upwd + dnwd
        IF (.NOT. ok_gust) wd = 0.  
615    
616         IF (thermcep) THEN         zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
617            zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)         zqsat = zqsat / (1. - retv * zqsat)
           zqsat = zqsat / (1. - retv * zqsat)  
        ELSE  
           zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play  
        ENDIF  
618    
619         ! Properties of convective clouds         ! Properties of convective clouds
620         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
621         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
622              rnebcon0)              rnebcon0)
623    
624           forall (i = 1:klon) ema_pct(i) = paprs(i, itop_con(i) + 1)
625         mfd = 0.         mfd = 0.
626         pen_u = 0.         pen_u = 0.
627         pen_d = 0.         pen_d = 0.
628         pde_d = 0.         pde_d = 0.
629         pde_u = 0.         pde_u = 0.
630        else
631           conv_q = d_q_dyn + d_q_vdf / dtphys
632           conv_t = d_t_dyn + d_t_vdf / dtphys
633           z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
634           CALL conflx(paprs, play, t_seri(:, llm:1:- 1), q_seri(:, llm:1:- 1), &
635                conv_t, conv_q, - evap, omega, d_t_con, d_q_con, rain_con, &
636                snow_con, mfu(:, llm:1:- 1), mfd(:, llm:1:- 1), pen_u, pde_u, &
637                pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
638           WHERE (rain_con < 0.) rain_con = 0.
639           WHERE (snow_con < 0.) snow_con = 0.
640           ibas_con = llm + 1 - kcbot
641           itop_con = llm + 1 - kctop
642      END if      END if
643    
644      DO k = 1, llm      DO k = 1, llm
# Line 990  contains Line 650  contains
650         ENDDO         ENDDO
651      ENDDO      ENDDO
652    
653      IF (if_ebil >= 2) THEN      IF (.not. conv_emanuel) THEN
        tit = 'after convect'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_con, snow_con, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "aprescon = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_con(i)+ &  
                snow_con(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (iflag_con == 2) THEN  
654         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
655         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
656         DO k = 1, llm         DO k = 1, llm
657            DO i = 1, klon            DO i = 1, klon
658               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) /= 1.) THEN
659                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
660               ENDIF               ENDIF
661            ENDDO            ENDDO
# Line 1033  contains Line 671  contains
671      fm_therm = 0.      fm_therm = 0.
672      entr_therm = 0.      entr_therm = 0.
673    
674      if (iflag_thermals == 0) then      if (iflag_thermals) then
675         ! Ajustement sec         call calltherm(play, paprs, pphi, u_seri, v_seri, t_seri, q_seri, &
676                d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
677        else
678         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, play, t_seri, q_seri, d_t_ajs, d_q_ajs)
679         t_seri = t_seri + d_t_ajs         t_seri = t_seri + d_t_ajs
680         q_seri = q_seri + d_q_ajs         q_seri = q_seri + d_q_ajs
     else  
        ! Thermiques  
        call calltherm(dtphys, play, paprs, pphi, u_seri, v_seri, t_seri, &  
             q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)  
681      endif      endif
682    
     IF (if_ebil >= 2) THEN  
        tit = 'after dry_adjust'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
     END IF  
   
683      ! Caclul des ratqs      ! Caclul des ratqs
684    
     ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q  
     ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno  
685      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
686           ! ratqs convectifs \`a l'ancienne en fonction de (q(z = 0) - q) / q
687           ! on \'ecrase le tableau ratqsc calcul\'e par clouds_gno
688         do k = 1, llm         do k = 1, llm
689            do i = 1, klon            do i = 1, klon
690               if(ptconv(i, k)) then               if(ptconv(i, k)) then
# Line 1071  contains Line 701  contains
701      do k = 1, llm      do k = 1, llm
702         do i = 1, klon         do i = 1, klon
703            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
704                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
705         enddo         enddo
706      enddo      enddo
707    
# Line 1088  contains Line 718  contains
718         ratqs = ratqss         ratqs = ratqss
719      endif      endif
720    
721      CALL fisrtilp(dtphys, paprs, play, t_seri, q_seri, ptconv, ratqs, &      CALL fisrtilp(paprs, play, t_seri, q_seri, ptconv, ratqs, d_t_lsc, &
722           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, &           d_q_lsc, d_ql_lsc, rneb, cldliq, rain_lsc, snow_lsc, pfrac_impa, &
723           pfrac_impa, pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, &           pfrac_nucl, pfrac_1nucl, frac_impa, frac_nucl, prfl, psfl, rhcl)
          psfl, rhcl)  
724    
725      WHERE (rain_lsc < 0) rain_lsc = 0.      WHERE (rain_lsc < 0) rain_lsc = 0.
726      WHERE (snow_lsc < 0) snow_lsc = 0.      WHERE (snow_lsc < 0) snow_lsc = 0.
# Line 1104  contains Line 733  contains
733            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)            IF (.NOT.new_oliq) cldliq(i, k) = ql_seri(i, k)
734         ENDDO         ENDDO
735      ENDDO      ENDDO
     IF (check) THEN  
        za = qcheck(paprs, q_seri, ql_seri)  
        print *, "apresilp = ", za  
        zx_t = 0.  
        za = 0.  
        DO i = 1, klon  
           za = za + airephy(i)/REAL(klon)  
           zx_t = zx_t + (rain_lsc(i) &  
                + snow_lsc(i))*airephy(i)/REAL(klon)  
        ENDDO  
        zx_t = zx_t/za*dtphys  
        print *, "Precip = ", zx_t  
     ENDIF  
   
     IF (if_ebil >= 2) THEN  
        tit = 'after fisrt'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, zero_v, zero_v, zero_v, zero_v, &  
             zero_v, zero_v, rain_lsc, snow_lsc, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
736    
737      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT      ! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
738    
739      ! 1. NUAGES CONVECTIFS      ! 1. NUAGES CONVECTIFS
740    
741      IF (iflag_cldcon <= -1) THEN      IF (iflag_cldcon <= - 1) THEN
742         ! seulement pour Tiedtke         ! seulement pour Tiedtke
743         snow_tiedtke = 0.         snow_tiedtke = 0.
744         if (iflag_cldcon == -1) then         if (iflag_cldcon == - 1) then
745            rain_tiedtke = rain_con            rain_tiedtke = rain_con
746         else         else
747            rain_tiedtke = 0.            rain_tiedtke = 0.
748            do k = 1, llm            do k = 1, llm
749               do i = 1, klon               do i = 1, klon
750                  if (d_q_con(i, k) < 0.) then                  if (d_q_con(i, k) < 0.) then
751                     rain_tiedtke(i) = rain_tiedtke(i)-d_q_con(i, k)/dtphys &                     rain_tiedtke(i) = rain_tiedtke(i) - d_q_con(i, k) / dtphys &
752                          *zmasse(i, k)                          * zmasse(i, k)
753                  endif                  endif
754               enddo               enddo
755            enddo            enddo
# Line 1176  contains Line 784  contains
784    
785         ! On prend la somme des fractions nuageuses et des contenus en eau         ! On prend la somme des fractions nuageuses et des contenus en eau
786         cldfra = min(max(cldfra, rnebcon), 1.)         cldfra = min(max(cldfra, rnebcon), 1.)
787         cldliq = cldliq + rnebcon*clwcon         cldliq = cldliq + rnebcon * clwcon
788      ENDIF      ENDIF
789    
790      ! 2. Nuages stratiformes      ! 2. Nuages stratiformes
# Line 1199  contains Line 807  contains
807         snow_fall(i) = snow_con(i) + snow_lsc(i)         snow_fall(i) = snow_con(i) + snow_lsc(i)
808      ENDDO      ENDDO
809    
     IF (if_ebil >= 2) CALL diagetpq(airephy, "after diagcld", ip_ebil, 2, 2, &  
          dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
   
810      ! Humidit\'e relative pour diagnostic :      ! Humidit\'e relative pour diagnostic :
811      DO k = 1, llm      DO k = 1, llm
812         DO i = 1, klon         DO i = 1, klon
813            zx_t = t_seri(i, k)            zx_qs = r2es * FOEEW(t_seri(i, k), rtt >= t_seri(i, k)) / play(i, k)
814            IF (thermcep) THEN            zx_qs = MIN(0.5, zx_qs)
815               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)            zcor = 1. / (1. - retv * zx_qs)
816               zx_qs = MIN(0.5, zx_qs)            zx_qs = zx_qs * zcor
817               zcor = 1./(1.-retv*zx_qs)            zx_rh(i, k) = q_seri(i, k) / zx_qs
              zx_qs = zx_qs*zcor  
           ELSE  
              IF (zx_t < t_coup) THEN  
                 zx_qs = qsats(zx_t)/play(i, k)  
              ELSE  
                 zx_qs = qsatl(zx_t)/play(i, k)  
              ENDIF  
           ENDIF  
           zx_rh(i, k) = q_seri(i, k)/zx_qs  
818            zqsat(i, k) = zx_qs            zqsat(i, k) = zx_qs
819         ENDDO         ENDDO
820      ENDDO      ENDDO
821    
     ! Introduce the aerosol direct and first indirect radiative forcings:  
     IF (ok_ade .OR. ok_aie) THEN  
        ! Get sulfate aerosol distribution :  
        CALL readsulfate(rdayvrai, firstcal, sulfate)  
        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)  
   
        CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &  
             aerindex)  
     ELSE  
        tau_ae = 0.  
        piz_ae = 0.  
        cg_ae = 0.  
     ENDIF  
   
822      ! Param\`etres optiques des nuages et quelques param\`etres pour      ! Param\`etres optiques des nuages et quelques param\`etres pour
823      ! diagnostics :      ! diagnostics :
824      if (ok_newmicro) then      if (ok_newmicro) then
825         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
826              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc)
             sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)  
827      else      else
828         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
829              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq)
             bl95_b1, cldtaupi, re, fl)  
830      endif      endif
831    
832      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
833      IF (MOD(itaprad, radpas) == 0) THEN         wo = ozonecm(REAL(julien), paprs)
834         DO i = 1, klon         albsol = sum(falbe * pctsrf, dim = 2)
835            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &         CALL radlwsw(dist, mu0, fract, paprs, play, tsol, albsol, t_seri, &
836                 + falbe(i, is_lic) * pctsrf(i, is_lic) &              q_seri, wo, cldfra, cldemi, cldtau, heat, heat0, cool, cool0, &
837                 + falbe(i, is_ter) * pctsrf(i, is_ter) &              radsol, albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, &
838                 + falbe(i, is_sic) * pctsrf(i, is_sic)              toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, &
839            albsollw(i) = falblw(i, is_oce) * pctsrf(i, is_oce) &              swup0, swup, ok_ade, topswad, solswad)
                + 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  
        ! Rayonnement (compatible Arpege-IFS) :  
        CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &  
             albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &  
             heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &  
             sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &  
             lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &  
             cg_ae, topswad, solswad, cldtaupi, topswai, solswai)  
        itaprad = 0  
840      ENDIF      ENDIF
     itaprad = itaprad + 1  
841    
842      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
   
843      DO k = 1, llm      DO k = 1, llm
844         DO i = 1, klon         DO i = 1, klon
845            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 &
846         ENDDO                 / 86400.
     ENDDO  
   
     IF (if_ebil >= 2) THEN  
        tit = 'after rad'  
        CALL diagetpq(airephy, tit, ip_ebil, 2, 2, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, &  
             zero_v, zero_v, zero_v, zero_v, ztsol, d_h_vcol, d_qt, d_ec)  
     END IF  
   
     ! Calculer l'hydrologie de la surface  
     DO i = 1, klon  
        zxqsurf(i) = 0.  
        zxsnow(i) = 0.  
     ENDDO  
     DO nsrf = 1, nbsrf  
        DO i = 1, klon  
           zxqsurf(i) = zxqsurf(i) + fqsurf(i, nsrf)*pctsrf(i, nsrf)  
           zxsnow(i) = zxsnow(i) + fsnow(i, nsrf)*pctsrf(i, nsrf)  
847         ENDDO         ENDDO
848      ENDDO      ENDDO
849    
850      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)      ! Calculer le bilan du sol et la d\'erive de temp\'erature (couplage)
   
851      DO i = 1, klon      DO i = 1, klon
852         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) + sens(i) + zxfluxlat(i)
853      ENDDO      ENDDO
854    
855      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :      ! Param\'etrisation de l'orographie \`a l'\'echelle sous-maille :
856    
857      IF (ok_orodr) THEN      IF (ok_orodr) THEN
858         ! selection des points pour lesquels le shema est actif:         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
859         DO i = 1, klon         DO i = 1, klon
860            itest(i) = 0            ktest(i) = 0
861            IF (((zpic(i)-zmea(i)) > 100.).AND.(zstd(i) > 10.)) THEN            IF (zpic(i) - zmea(i) > 100. .AND. zstd(i) > 10.) THEN
862               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
863            ENDIF            ENDIF
864         ENDDO         ENDDO
865    
866         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(paprs, play, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
867              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              ktest, t_seri, u_seri, v_seri, zulow, zvlow, zustrdr, zvstrdr, &
868              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              d_t_oro, d_u_oro, d_v_oro)
869    
870         ! ajout des tendances         ! ajout des tendances
871         DO k = 1, llm         DO k = 1, llm
# Line 1337  contains Line 879  contains
879    
880      IF (ok_orolf) THEN      IF (ok_orolf) THEN
881         ! S\'election des points pour lesquels le sch\'ema est actif :         ! S\'election des points pour lesquels le sch\'ema est actif :
        igwd = 0  
882         DO i = 1, klon         DO i = 1, klon
883            itest(i) = 0            ktest(i) = 0
884            IF ((zpic(i) - zmea(i)) > 100.) THEN            IF (zpic(i) - zmea(i) > 100.) THEN
885               itest(i) = 1               ktest(i) = 1
              igwd = igwd + 1  
              idx(igwd) = i  
886            ENDIF            ENDIF
887         ENDDO         ENDDO
888    
889         CALL lift_noro(klon, llm, dtphys, paprs, play, rlat, zmea, zstd, zpic, &         CALL lift_noro(paprs, play, zmea, zstd, zpic, ktest, t_seri, u_seri, &
890              itest, t_seri, u_seri, v_seri, zulow, zvlow, zustrli, zvstrli, &              v_seri, zulow, zvlow, zustrli, zvstrli, d_t_lif, d_u_lif, d_v_lif)
             d_t_lif, d_u_lif, d_v_lif)  
891    
892         ! Ajout des tendances :         ! Ajout des tendances :
893         DO k = 1, llm         DO k = 1, llm
# Line 1361  contains Line 899  contains
899         ENDDO         ENDDO
900      ENDIF      ENDIF
901    
902      ! Stress n\'ecessaires : toute la physique      CALL aaam_bud(rg, romega, pphis, zustrdr, zustrli, &
903             sum((u_seri - u) / dtphys * zmasse, dim = 2), zvstrdr, &
904      DO i = 1, klon           zvstrli, sum((v_seri - v) / dtphys * zmasse, dim = 2), paprs, u, v, &
905         zustrph(i) = 0.           aam, torsfc)
        zvstrph(i) = 0.  
     ENDDO  
     DO k = 1, llm  
        DO i = 1, klon  
           zustrph(i) = zustrph(i) + (u_seri(i, k) - u(i, k)) / dtphys &  
                * zmasse(i, k)  
           zvstrph(i) = zvstrph(i) + (v_seri(i, k) - v(i, k)) / dtphys &  
                * zmasse(i, k)  
        ENDDO  
     ENDDO  
   
     CALL aaam_bud(ra, rg, romega, rlat, rlon, pphis, zustrdr, zustrli, &  
          zustrph, zvstrdr, zvstrli, zvstrph, paprs, u, v, aam, torsfc)  
   
     IF (if_ebil >= 2) CALL diagetpq(airephy, 'after orography', ip_ebil, 2, &  
          2, dtphys, t_seri, q_seri, ql_seri, u_seri, v_seri, paprs, d_h_vcol, &  
          d_qt, d_ec)  
906    
907      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
908      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &      call phytrac(julien, time, firstcal, lafin, t, paprs, play, mfu, mfd, &
909           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, u(:, 1), v(:, 1), &
910           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &           ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
911           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &           tr_seri, zmasse, ncid_startphy)
          mp, upwd, dnwd, tr_seri, zmasse)  
   
     IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &  
          pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &  
          pctsrf, frac_impa, frac_nucl, pphis, airephy, dtphys, itap)  
912    
913      ! Calculer le transport de l'eau et de l'energie (diagnostique)      ! Calculer le transport de l'eau et de l'energie (diagnostique)
914      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)  
915    
916      ! diag. bilKP      ! diag. bilKP
917    
918      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, ve_lay, &
919           ve_lay, vq_lay, ue_lay, uq_lay)           vq_lay, ue_lay, uq_lay)
920    
921      ! Accumuler les variables a stocker dans les fichiers histoire:      ! Accumuler les variables a stocker dans les fichiers histoire:
922    
923      ! conversion Ec -> E thermique      ! conversion Ec en énergie thermique
924      DO k = 1, llm      DO k = 1, llm
925         DO i = 1, klon         DO i = 1, klon
926            ZRCPD = RCPD * (1. + RVTMP2 * q_seri(i, k))            d_t_ec(i, k) = 0.5 / (RCPD * (1. + RVTMP2 * q_seri(i, k))) &
           d_t_ec(i, k) = 0.5 / ZRCPD &  
927                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)                 * (u(i, k)**2 + v(i, k)**2 - u_seri(i, k)**2 - v_seri(i, k)**2)
928            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)            t_seri(i, k) = t_seri(i, k) + d_t_ec(i, k)
929            d_t_ec(i, k) = d_t_ec(i, k) / dtphys            d_t_ec(i, k) = d_t_ec(i, k) / dtphys
930         END DO         END DO
931      END DO      END DO
932    
     IF (if_ebil >= 1) THEN  
        tit = 'after physic'  
        CALL diagetpq(airephy, tit, ip_ebil, 1, 1, dtphys, t_seri, q_seri, &  
             ql_seri, u_seri, v_seri, paprs, d_h_vcol, d_qt, d_ec)  
        ! Comme les tendances de la physique sont ajoute dans la dynamique,  
        ! on devrait avoir que la variation d'entalpie par la dynamique  
        ! est egale a la variation de la physique au pas de temps precedent.  
        ! Donc la somme de ces 2 variations devrait etre nulle.  
        call diagphy(airephy, tit, ip_ebil, topsw, toplw, solsw, sollw, sens, &  
             evap, rain_fall, snow_fall, ztsol, d_h_vcol, d_qt, d_ec)  
        d_h_vcol_phy = d_h_vcol  
     END IF  
   
933      ! SORTIES      ! SORTIES
934    
935      ! prw = eau precipitable      ! prw = eau precipitable
936      DO i = 1, klon      DO i = 1, klon
937         prw(i) = 0.         prw(i) = 0.
938         DO k = 1, llm         DO k = 1, llm
939            prw(i) = prw(i) + q_seri(i, k)*zmasse(i, k)            prw(i) = prw(i) + q_seri(i, k) * zmasse(i, k)
940         ENDDO         ENDDO
941      ENDDO      ENDDO
942    
# Line 1454  contains Line 955  contains
955      DO iq = 3, nqmx      DO iq = 3, nqmx
956         DO k = 1, llm         DO k = 1, llm
957            DO i = 1, klon            DO i = 1, klon
958               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
959            ENDDO            ENDDO
960         ENDDO         ENDDO
961      ENDDO      ENDDO
# Line 1467  contains Line 968  contains
968         ENDDO         ENDDO
969      ENDDO      ENDDO
970    
971      ! Ecriture des sorties      CALL histwrite_phy("phis", pphis)
972      call write_histins      CALL histwrite_phy("aire", airephy)
973        CALL histwrite_phy("psol", paprs(:, 1))
974      ! Si c'est la fin, il faut conserver l'etat de redemarrage      CALL histwrite_phy("precip", rain_fall + snow_fall)
975      IF (lafin) THEN      CALL histwrite_phy("plul", rain_lsc + snow_lsc)
976         itau_phy = itau_phy + itap      CALL histwrite_phy("pluc", rain_con + snow_con)
977         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &      CALL histwrite_phy("tsol", tsol)
978              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &      CALL histwrite_phy("t2m", zt2m)
979              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &      CALL histwrite_phy("q2m", zq2m)
980              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &      CALL histwrite_phy("u10m", u10m)
981              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      CALL histwrite_phy("v10m", v10m)
982      ENDIF      CALL histwrite_phy("snow", snow_fall)
983        CALL histwrite_phy("cdrm", cdragm)
984      firstcal = .FALSE.      CALL histwrite_phy("cdrh", cdragh)
985        CALL histwrite_phy("topl", toplw)
986    contains      CALL histwrite_phy("evap", evap)
987        CALL histwrite_phy("sols", solsw)
988      subroutine write_histins      CALL histwrite_phy("rls", sollw)
989        CALL histwrite_phy("solldown", sollwdown)
990        ! From phylmd/write_histins.h, version 1.2 2005/05/25 13:10:09      CALL histwrite_phy("bils", bils)
991        CALL histwrite_phy("sens", sens)
992        use dimens_m, only: iim, jjm      CALL histwrite_phy("fder", fder)
993        USE histsync_m, ONLY: histsync      CALL histwrite_phy("dtsvdfo", d_ts(:, is_oce))
994        USE histwrite_m, ONLY: histwrite      CALL histwrite_phy("dtsvdft", d_ts(:, is_ter))
995        CALL histwrite_phy("dtsvdfg", d_ts(:, is_lic))
996        real zout      CALL histwrite_phy("dtsvdfi", d_ts(:, is_sic))
997        integer itau_w ! pas de temps ecriture      CALL histwrite_phy("zxfqcalving", sum(fqcalving * pctsrf, dim = 2))
998        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)      CALL histwrite_phy("albs", albsol)
999        CALL histwrite_phy("tro3", wo * dobson_u * 1e3 / zmasse / rmo3 * md)
1000        !--------------------------------------------------      CALL histwrite_phy("rugs", zxrugs)
1001        CALL histwrite_phy("s_pblh", s_pblh)
1002        IF (ok_instan) THEN      CALL histwrite_phy("s_pblt", s_pblt)
1003           ! Champs 2D:      CALL histwrite_phy("s_lcl", s_lcl)
1004        CALL histwrite_phy("s_capCL", s_capCL)
1005           zsto = dtphys * ecrit_ins      CALL histwrite_phy("s_oliqCL", s_oliqCL)
1006           zout = dtphys * ecrit_ins      CALL histwrite_phy("s_cteiCL", s_cteiCL)
1007           itau_w = itau_phy + itap      CALL histwrite_phy("s_therm", s_therm)
1008        CALL histwrite_phy("temp", t_seri)
1009           i = NINT(zout/zsto)      CALL histwrite_phy("vitu", u_seri)
1010           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)      CALL histwrite_phy("vitv", v_seri)
1011           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)      CALL histwrite_phy("geop", zphi)
1012        CALL histwrite_phy("pres", play)
1013           i = NINT(zout/zsto)      CALL histwrite_phy("dtvdf", d_t_vdf)
1014           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)      CALL histwrite_phy("dqvdf", d_q_vdf)
1015           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)      CALL histwrite_phy("rhum", zx_rh)
1016        CALL histwrite_phy("d_t_ec", d_t_ec)
1017           DO i = 1, klon      CALL histwrite_phy("dtsw0", heat0 / 86400.)
1018              zx_tmp_fi2d(i) = paprs(i, 1)      CALL histwrite_phy("dtlw0", - cool0 / 86400.)
1019           ENDDO      call histwrite_phy("pmflxr", pmflxr(:, :llm))
1020           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)      CALL histwrite_phy("msnow", sum(fsnow * pctsrf, dim = 2))
1021           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)      call histwrite_phy("qsurf", sum(fqsurf * pctsrf, dim = 2))
1022        call histwrite_phy("flat", zxfluxlat)
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)  
   
          DO i = 1, klon  
             zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)  
          ENDDO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)  
1023    
1024           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxtsol, zx_tmp_2d)      DO nsrf = 1, nbsrf
1025           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)         CALL histwrite_phy("fract_"//clnsurf(nsrf), pctsrf(:, nsrf))
1026           !ccIM         CALL histwrite_phy("sens_"//clnsurf(nsrf), flux_t(:, nsrf))
1027           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zt2m, zx_tmp_2d)         CALL histwrite_phy("lat_"//clnsurf(nsrf), fluxlat(:, nsrf))
1028           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)         CALL histwrite_phy("tsol_"//clnsurf(nsrf), ftsol(:, nsrf))
1029           CALL histwrite_phy("taux_"//clnsurf(nsrf), flux_u(:, nsrf))
1030           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zq2m, zx_tmp_2d)         CALL histwrite_phy("tauy_"//clnsurf(nsrf), flux_v(:, nsrf))
1031           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)         CALL histwrite_phy("rugs_"//clnsurf(nsrf), frugs(:, nsrf))
1032           CALL histwrite_phy("albe_"//clnsurf(nsrf), falbe(:, nsrf))
1033           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zu10m, zx_tmp_2d)         CALL histwrite_phy("u10m_"//clnsurf(nsrf), u10m_srf(:, nsrf))
1034           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)         CALL histwrite_phy("v10m_"//clnsurf(nsrf), v10m_srf(:, nsrf))
1035        END DO
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zv10m, zx_tmp_2d)  
          CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, snow_fall, zx_tmp_2d)  
          CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, cdragh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, toplw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, evap, zx_tmp_2d)  
          CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, solsw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollw, zx_tmp_2d)  
          CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sollwdown, zx_tmp_2d)  
          CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, bils, zx_tmp_2d)  
          CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)  
   
          zx_tmp_fi2d(1:klon) = -1*sens(1:klon)  
          ! CALL gr_fi_ecrit(1, klon, iim, jjm + 1, sens, zx_tmp_2d)  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
          CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, fder, zx_tmp_2d)  
          CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_oce), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_ter), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_lic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, d_ts(1, is_sic), zx_tmp_2d)  
          CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)  
   
          DO nsrf = 1, nbsrf  
             !XXX  
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)*100.  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxt(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxlat(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxu(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = fluxv(1 : klon, 1, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = frugs(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
             zx_tmp_fi2d(1 : klon) = falbe(1 : klon, nsrf)  
             CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zx_tmp_fi2d, zx_tmp_2d)  
             CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &  
                  zx_tmp_2d)  
   
          END DO  
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, albsol, 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)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, zxrugs, zx_tmp_2d)  
          CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)  
   
          !HBTM2  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblh, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_pblt, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_lcl, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_capCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_oliqCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_cteiCL, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_therm, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb1, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb2, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)  
   
          CALL gr_fi_ecrit(1, klon, iim, jjm + 1, s_trmb3, zx_tmp_2d)  
          CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)  
   
          ! Champs 3D:  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, t_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, u_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, v_seri, zx_tmp_3d)  
          CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, zphi, zx_tmp_3d)  
          CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, play, zx_tmp_3d)  
          CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_t_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)  
   
          CALL gr_fi_ecrit(llm, klon, iim, jjm + 1, d_q_vdf, zx_tmp_3d)  
          CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)  
1036    
1037           call histsync(nid_ins)      if (conv_emanuel) then
1038        ENDIF         CALL histwrite_phy("ptop", ema_pct)
1039           CALL histwrite_phy("dnwd0", - mp)
1040        end if
1041    
1042        if (ok_instan) call histsync(nid_ins)
1043    
1044        IF (lafin) then
1045           call NF95_CLOSE(ncid_startphy)
1046           CALL phyredem(pctsrf, ftsol, ftsoil, fqsurf, qsol, fsnow, falbe, &
1047                rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, &
1048                zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &
1049                rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)
1050        end IF
1051    
1052      end subroutine write_histins      firstcal = .FALSE.
1053    
1054    END SUBROUTINE physiq    END SUBROUTINE physiq
1055    
Legend:
Removed from v.103  
changed lines
  Added in v.326
  ViewVC Help
Powered by ViewVC 1.1.21