/[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

revision 149 by guez, Thu Jun 18 12:23:44 2015 UTC revision 207 by guez, Thu Sep 1 10:30:53 2016 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, jour, rmu0, 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, snow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         zv1, t2m, q2m, u10m, v10m, 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 31  contains Line 30  contains
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):: jour ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temperature du sol (en Kelvin)
     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 70  contains Line 67  contains
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):: snow(klon, nbsrf)
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)
     REAL alblw(klon, nbsrf)  
74    
75      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
76    
# Line 85  contains Line 81  contains
81      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
82    
83      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84      REAL fder(klon)      REAL, intent(in):: fder(klon)
85      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86    
87      REAL rugos(klon, nbsrf)      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
     ! rugos----input-R- longeur de rugosite (en m)  
88    
     LOGICAL, INTENT(IN):: debut  
89      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
90      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
91    
# Line 102  contains Line 96  contains
96      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97      ! changement pour "u" et "v"      ! changement pour "u" et "v"
98    
99      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ftsol"
100    
101        REAL, intent(out):: flux_t(klon, nbsrf)
102        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
103        ! le bas) à la surface
104    
105      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
106      ! 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
107      !                    (orientation positive vers le bas)  
108      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
109        ! 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  
110    
111      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
112      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 119  contains Line 114  contains
114      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
115      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
116      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
117      !IM "slab" ocean      ! IM "slab" ocean
118    
119      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
120      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 127  contains Line 122  contains
122      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
123      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
124    
125      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
126      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
127      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
128      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
129      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
130      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
131      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 150  contains Line 145  contains
145      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
146      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
147    
     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  
   
148      ! Local:      ! Local:
149    
150      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
151      real ytslab(klon)  
152        ! la nouvelle repartition des surfaces sortie de l'interface
153        REAL, save:: pctsrf_new_oce(klon)
154        REAL, save:: pctsrf_new_sic(klon)
155    
156      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
157      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
158      REAL rugmer(klon)      REAL rugmer(klon)
   
159      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
160      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
161      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
162      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
163      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
164      ! la premiere couche      ! la premiere couche
# Line 187  contains Line 173  contains
173      REAL ysnow_f(klon)      REAL ysnow_f(klon)
174      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
175    
     REAL ysollw(klon), ysolsw(klon)  
176      REAL yfder(klon)      REAL yfder(klon)
177      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
178    
# Line 196  contains Line 181  contains
181      REAL y_d_ts(klon)      REAL y_d_ts(klon)
182      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
183      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
184      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
185      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
186      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
187      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
188      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 222  contains Line 207  contains
207      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
208      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
209    
210      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
211    
212      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
213      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
214    
215      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
216      REAL ypblh(klon)      REAL ypblh(klon)
# Line 282  contains Line 262  contains
262      yts = 0.      yts = 0.
263      ysnow = 0.      ysnow = 0.
264      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
265      yrain_f = 0.      yrain_f = 0.
266      ysnow_f = 0.      ysnow_f = 0.
267      yfder = 0.      yfder = 0.
     ysolsw = 0.  
     ysollw = 0.  
268      yrugos = 0.      yrugos = 0.
269      yu1 = 0.      yu1 = 0.
270      yv1 = 0.      yv1 = 0.
# Line 300  contains Line 276  contains
276      yv = 0.      yv = 0.
277      yt = 0.      yt = 0.
278      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
279      y_dflux_t = 0.      y_dflux_t = 0.
280      y_dflux_q = 0.      y_dflux_q = 0.
281      ytsoil = 999999.      ytsoil = 999999.
282      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
283      d_ts = 0.      d_ts = 0.
284      yfluxlat = 0.      yfluxlat = 0.
285      flux_t = 0.      flux_t = 0.
# Line 326  contains Line 296  contains
296      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
297      ! (\`a affiner)      ! (\`a affiner)
298    
299      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
300        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
301      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
302      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
303    
304        ! Tester si c'est le moment de lire le fichier:
305        if (mod(itap - 1, lmt_pas) == 0) then
306           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
307        endif
308    
309      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
310    
311      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 349  contains Line 325  contains
325            DO j = 1, knon            DO j = 1, knon
326               i = ni(j)               i = ni(j)
327               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
328               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
              ytslab(i) = tslab(i)  
329               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
330               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
331               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
332               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
333               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
334               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
335               yfder(j) = fder(i)               yfder(j) = fder(i)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
336               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
337               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
338               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
339               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
340               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
341               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
342               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))  
343            END DO            END DO
344    
345            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 472  contains Line 441  contains
441    
442            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
443            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
444                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
445            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
446                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
447    
448            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
449            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &
450                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
451                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
452                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
453                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
454                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &
455                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_flux_g)  
456    
457            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
458            yrugm = 0.            yrugm = 0.
# Line 509  contains Line 477  contains
477                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
478                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
479                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
480                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
481                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
482               END DO               END DO
483            END DO            END DO
484    
485            evap(:, nsrf) = -flux_q(:, 1, nsrf)            DO j = 1, knon
486                 i = ni(j)
487                 flux_t(i, nsrf) = y_flux_t(j)
488                 flux_q(i, nsrf) = y_flux_q(j)
489                 flux_u(i, nsrf) = y_flux_u(j)
490                 flux_v(i, nsrf) = y_flux_v(j)
491              END DO
492    
493              evap(:, nsrf) = -flux_q(:, nsrf)
494    
495            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
496            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
497            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
498            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 529  contains Line 500  contains
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
502               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
503               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
504               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
505               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
506               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 613  contains Line 583  contains
583    
584            END DO            END DO
585    
586            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
587                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
588                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589    
590            DO j = 1, knon            DO j = 1, knon
591               i = ni(j)               i = ni(j)
# Line 637  contains Line 607  contains
607                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
608               END DO               END DO
609            END DO            END DO
           !IM "slab" ocean  
           IF (nsrf == is_oce) THEN  
              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\`ere 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  
610         end IF if_knon         end IF if_knon
611      END DO loop_surface      END DO loop_surface
612    
613      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
614      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
615      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
616        pctsrf(:, is_sic) = pctsrf_new_sic
617    
618        firstcal = .false.
619    
620    END SUBROUTINE clmain    END SUBROUTINE clmain
621    
Legend:
Removed from v.149  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21