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

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

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

trunk/phylmd/clmain.f revision 118 by guez, Thu Dec 18 17:30:24 2014 UTC trunk/Sources/phylmd/clmain.f revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
14    
15      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
# Line 19  contains Line 18  contains
18    
19      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
21      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! sol.      ! de sol.
23    
24      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! dans la première couche, trois champs ont été créés : "ycoefh",      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
28    
29      use clqh_m, only: clqh      use clqh_m, only: clqh
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
38      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
39        USE interfoce_lim_m, ONLY: interfoce_lim
40      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42        use time_phylmdz, only: itap
43      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
44      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
45      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
46    
47      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
     REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
# Line 65  contains Line 62  contains
62      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63      ! soil temperature of surface fraction      ! soil temperature of surface fraction
64    
65      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: qsol(:) ! (klon)
66      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
74      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
   
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
77      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
78    
79      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_f(klon)
80      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83      REAL fder(klon)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
84      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 102  contains Line 91  contains
91      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
92      ! changement pour "u" et "v"      ! changement pour "u" et "v"
93    
94      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95    
96        REAL, intent(out):: flux_t(klon, nbsrf)
97        ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
98        ! le bas) à la surface
99    
100      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
101      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de vapeur d'eau (kg / m2 / s) à la surface
102      !                    (orientation positive vers le bas)  
103      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104        ! tension du vent à la surface, en Pa
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
105    
106      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
107      real q2(klon, klev+1, nbsrf)      real q2(klon, klev + 1, nbsrf)
108    
109      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
110      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
111      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
112      !IM "slab" ocean      ! IM "slab" ocean
113    
114      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
115      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon), zv1(klon)
116      REAL zv1(klon)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
119        ! composantes du vent \`a 10m sans spirale d'Ekman
120      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
121      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
122      REAL pblh(klon, nbsrf)      ! Comme les autres diagnostics on cumule dans physiq ce qui permet
123      ! pblh------- HCL      ! de sortir les grandeurs par sous-surface.
124        REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
128      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
129      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
130      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
131      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 147  contains Line 137  contains
137      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
138      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
139      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
140      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg / m2 / s
141      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
142    
     REAL flux_o(klon), flux_g(klon)  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
   
143      ! Local:      ! Local:
144    
145      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
146      real ytslab(klon)  
147        ! la nouvelle repartition des surfaces sortie de l'interface
148        REAL, save:: pctsrf_new_oce(klon)
149        REAL, save:: pctsrf_new_sic(klon)
150    
151      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
152      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
153      REAL rugmer(klon)      REAL rugmer(klon)
   
154      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
155      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
     REAL yu1(klon), yv1(klon)  
     ! on rajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premiere couche  
     REAL ysnow(klon), yqsurf(klon), yagesno(klon)  
   
     real yqsol(klon)  
     ! column-density of water in soil, in kg m-2  
157    
158      REAL yrain_f(klon)      REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
159      ! liquid water mass flux (kg/m2/s), positive down                                ! une sous-surface donnée
160        
161      REAL ysnow_f(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
162      ! solid water mass flux (kg/m2/s), positive down      real yqsol(klon) ! column-density of water in soil, in kg m-2
163        REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
164      REAL ysollw(klon), ysolsw(klon)      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
     REAL yfder(klon)  
165      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
166      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
167      REAL y_d_ts(klon)      REAL y_d_ts(klon)
168      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
169      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
170      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
171      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
172      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
173      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
174      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
175      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
176      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
177    
178      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
179    
180      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
181      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
182      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
183      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
184      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
185    
     REAL u1lay(klon), v1lay(klon)  
186      REAL delp(klon, klev)      REAL delp(klon, klev)
187      INTEGER i, k, nsrf      INTEGER i, k, nsrf
188    
189      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
190    
191      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
192      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
193      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
194    
     REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.  
   
195      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
196      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
197    
198      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
199      REAL ypblh(klon)      REAL ypblh(klon)
# Line 260  contains Line 223  contains
223    
224      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
225         DO i = 1, klon         DO i = 1, klon
226            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
227         END DO         END DO
228      END DO      END DO
     DO i = 1, klon ! vent de la premiere couche  
        zx_alf1 = 1.0  
        zx_alf2 = 1.0 - zx_alf1  
        u1lay(i) = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2  
        v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2  
     END DO  
229    
230      ! Initialization:      ! Initialization:
231      rugmer = 0.      rugmer = 0.
# Line 279  contains Line 236  contains
236      zu1 = 0.      zu1 = 0.
237      zv1 = 0.      zv1 = 0.
238      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
239      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
240      yrain_f = 0.      yrain_f = 0.
241      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ysolsw = 0.  
     ysollw = 0.  
242      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
243      ypaprs = 0.      ypaprs = 0.
244      ypplay = 0.      ypplay = 0.
245      ydelp = 0.      ydelp = 0.
# Line 300  contains Line 247  contains
247      yv = 0.      yv = 0.
248      yt = 0.      yt = 0.
249      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
250      y_dflux_t = 0.      y_dflux_t = 0.
251      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
252      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
253      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
254      flux_t = 0.      flux_t = 0.
255      flux_q = 0.      flux_q = 0.
256      flux_u = 0.      flux_u = 0.
257      flux_v = 0.      flux_v = 0.
258        fluxlat = 0.
259      d_t = 0.      d_t = 0.
260      d_q = 0.      d_q = 0.
261      d_u = 0.      d_u = 0.
262      d_v = 0.      d_v = 0.
263      ycoefh = 0.      ycoefh = 0.
264    
265      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
266      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
267      ! (à affiner)      ! (\`a affiner)
268    
269      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
270        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
271      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
272      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
273    
274        ! Tester si c'est le moment de lire le fichier:
275        if (mod(itap - 1, lmt_pas) == 0) then
276           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
277        endif
278    
279      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
280    
281      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 337  contains Line 283  contains
283         ni = 0         ni = 0
284         knon = 0         knon = 0
285         DO i = 1, klon         DO i = 1, klon
286            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
287            ! "potentielles"            ! "potentielles"
288            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
289               knon = knon + 1               knon = knon + 1
# Line 349  contains Line 295  contains
295            DO j = 1, knon            DO j = 1, knon
296               i = ni(j)               i = ni(j)
297               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
298               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
299               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
300               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
301               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
302               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
303               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
304               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
305               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
              yrugos(j) = rugos(i, nsrf)  
306               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
307               yu1(j) = u1lay(i)               u1lay(j) = u(i, 1)
308               yv1(j) = v1lay(i)               v1lay(j) = v(i, 1)
309               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
310               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
311               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
              yu10mx(j) = u10m(i, nsrf)  
              yu10my(j) = v10m(i, nsrf)  
              ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))  
312            END DO            END DO
313    
314            ! For continent, copy soil water content            ! For continent, copy soil water content
315            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              yqsol(:knon) = qsol(ni(:knon))  
           ELSE  
              yqsol = 0.  
           END IF  
316    
317            DO k = 1, nsoilmx            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
              DO j = 1, knon  
                 i = ni(j)  
                 ytsoil(j, k) = ftsoil(i, k, nsrf)  
              END DO  
           END DO  
318    
319            DO k = 1, klev            DO k = 1, klev
320               DO j = 1, knon               DO j = 1, knon
# Line 401  contains Line 330  contains
330            END DO            END DO
331    
332            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
333            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
334                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
335                   coefh(:knon, :))
336            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
337               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
338               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 424  contains Line 354  contains
354            END IF            END IF
355    
356            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
357               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
358               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
359               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
360                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
361                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 436  contains Line 366  contains
366                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
367               END DO               END DO
368               DO k = 1, klev               DO k = 1, klev
369                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
370                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
371               END DO               END DO
372               yzlev(1:knon, 1) = 0.               yzlev(1:knon, 1) = 0.
373               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
374                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
375               DO k = 2, klev               DO k = 2, klev
376                  yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))                  yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))
377               END DO               END DO
378               DO k = 1, klev + 1               DO k = 1, klev + 1
379                  DO j = 1, knon                  DO j = 1, knon
# Line 455  contains Line 385  contains
385               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
386               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
387    
388               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
389    
390               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
391                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
392                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
393                       yustar, iflag_pbl)                       iflag_pbl)
394               ELSE               ELSE
395                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
396                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 471  contains Line 401  contains
401            END IF            END IF
402    
403            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
404            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
405                 ypplay, ydelp, y_d_u, y_flux_u)                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
406            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
407                 ypplay, ydelp, y_d_v, y_flux_v)            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
408                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
409                   y_flux_v(:knon))
410    
411            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
412            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
413                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
414                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
415                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
416                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
417                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
418                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
419                 y_flux_g)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
420    
421            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
422            yrugm = 0.            yrugm = 0.
423            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
424               DO j = 1, knon               DO j = 1, knon
425                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &
426                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
427                         / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
428                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
429               END DO               END DO
430            END IF            END IF
431            DO j = 1, knon            DO j = 1, knon
432               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
433               y_dflux_q(j) = y_dflux_q(j)*ypct(j)               y_dflux_q(j) = y_dflux_q(j) * ypct(j)
              yu1(j) = yu1(j)*ypct(j)  
              yv1(j) = yv1(j)*ypct(j)  
434            END DO            END DO
435    
436            DO k = 1, klev            DO k = 1, klev
437               DO j = 1, knon               DO j = 1, knon
438                  i = ni(j)                  i = ni(j)
439                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
440                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
441                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
442                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
443                  flux_t(i, k, nsrf) = y_flux_t(j, k)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
444                  flux_q(i, k, nsrf) = y_flux_q(j, k)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
                 y_d_u(j, k) = y_d_u(j, k)*ypct(j)  
                 y_d_v(j, k) = y_d_v(j, k)*ypct(j)  
445               END DO               END DO
446            END DO            END DO
447    
448            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
449              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
450              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
451              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
452    
453              evap(:, nsrf) = -flux_q(:, nsrf)
454    
455            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
456            alblw(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
           snow(:, nsrf) = 0.  
457            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
458            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
461               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
462               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
463               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
464               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
465               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
466               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
467               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
468                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
469                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
470               END IF               END IF
471               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
472               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 546  contains Line 475  contains
475               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
476               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
477               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
478               zu1(i) = zu1(i) + yu1(j)               zu1(i) = zu1(i) + u1lay(j) * ypct(j)
479               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + v1lay(j) * ypct(j)
480            END DO            END DO
481            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
482               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 559  contains Line 488  contains
488            END IF            END IF
489    
490            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
491            DO k = 1, nsoilmx            ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
              DO j = 1, knon  
                 i = ni(j)  
                 ftsoil(i, k, nsrf) = ytsoil(j, k)  
              END DO  
           END DO  
492    
493            DO j = 1, knon            DO j = 1, knon
494               i = ni(j)               i = ni(j)
# Line 585  contains Line 509  contains
509               vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
510               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
511               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
512               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
513                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
514               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
515               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
516               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
517                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
518               END IF               END IF
519               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
520               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 598  contains Line 522  contains
522               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
523            END DO            END DO
524    
525            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
526                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
527                 yt10m, yq10m, yu10m, yustar)                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
528    
529            DO j = 1, knon            DO j = 1, knon
530               i = ni(j)               i = ni(j)
531               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
532               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
533    
534               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
535               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(uzon(j)**2 + vmer(j)**2)
536               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
537                      / sqrt(uzon(j)**2 + vmer(j)**2)
538            END DO            END DO
539    
540            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
541                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
542                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
543    
544            DO j = 1, knon            DO j = 1, knon
545               i = ni(j)               i = ni(j)
# Line 637  contains Line 561  contains
561                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
562               END DO               END DO
563            END DO            END DO
564            !IM "slab" ocean         else
565            IF (nsrf == is_oce) THEN            fsnow(:, nsrf) = 0.
              DO j = 1, knon  
                 ! on projette sur la grille globale  
                 i = ni(j)  
                 IF (pctsrf_new(i, is_oce)>epsfra) THEN  
                    flux_o(i) = y_flux_o(j)  
                 ELSE  
                    flux_o(i) = 0.  
                 END IF  
              END DO  
           END IF  
   
           IF (nsrf == is_sic) THEN  
              DO j = 1, knon  
                 i = ni(j)  
                 ! On pondère lorsque l'on fait le bilan au sol :  
                 IF (pctsrf_new(i, is_sic)>epsfra) THEN  
                    flux_g(i) = y_flux_g(j)  
                 ELSE  
                    flux_g(i) = 0.  
                 END IF  
              END DO  
   
           END IF  
566         end IF if_knon         end IF if_knon
567      END DO loop_surface      END DO loop_surface
568    
569      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
570        frugs(:, is_oce) = rugmer
571        pctsrf(:, is_oce) = pctsrf_new_oce
572        pctsrf(:, is_sic) = pctsrf_new_sic
573    
574      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
575    
576    END SUBROUTINE clmain    END SUBROUTINE clmain
577    
Legend:
Removed from v.118  
changed lines
  Added in v.225
  ViewVC Help
Powered by ViewVC 1.1.21