/[lmdze]/trunk/phylmd/Interface_surf/pbl_surface.f90
ViewVC logotype

Diff of /trunk/phylmd/Interface_surf/pbl_surface.f90

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

trunk/phylmd/pbl_surface.f revision 282 by guez, Fri Jul 20 16:46:48 2018 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 309 by guez, Thu Sep 27 14:58:10 2018 UTC
# Line 4  module pbl_surface_m Line 4  module pbl_surface_m
4    
5  contains  contains
6    
7    SUBROUTINE pbl_surface(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, &    SUBROUTINE pbl_surface(pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdmmax, cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, &         cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, falbe, fluxlat, &
9         fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, &         rain_fall, snow_fall, frugs, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, &
10         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, &
11         q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &         coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, &
12         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)         therm, plcl, fqcalving, ffonte, run_off_lic_0, albsol, sollw, solsw, &
13           tsol)
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 Aug. 18th      ! Author: Z. X. Li (LMD/CNRS)
17        ! Date: Aug. 18th, 1993
18      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
19    
20      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
# Line 29  contains Line 31  contains
31      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
32      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
33      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
34        USE histwrite_phy_m, ONLY: histwrite_phy
35      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
36      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
37      use phyetat0_m, only: zmasq      use phyetat0_m, only: zmasq
38      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
39      USE suphec_m, ONLY: rd, rg      USE suphec_m, ONLY: rd, rg, rsigma
40      use time_phylmdz, only: itap      use time_phylmdz, only: itap
41    
     REAL, INTENT(IN):: dtime ! interval du temps (secondes)  
   
42      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
43      ! tableau des pourcentages de surface de chaque maille      ! pourcentages de surface de chaque maille
44    
45      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
46      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)
# Line 56  contains Line 57  contains
57      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
58    
59      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
60      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: play(klon, klev) ! pression au milieu de couche (Pa)
61      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
62      REAL qsurf(klon, nbsrf)      REAL, INTENT(inout):: fqsurf(klon, nbsrf)
     REAL evap(klon, nbsrf)  
63      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
64      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
65    
66      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
67      ! liquid water mass flux (kg / m2 / s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
68    
69      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_fall(klon)
70      ! solid water mass flux (kg / m2 / s), positive down      ! solid water mass flux (kg / m2 / s), positive down
71    
     REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)  
72      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
73      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
74      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
75    
76      REAL, intent(out):: d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(:, :), d_q(:, :) ! (klon, klev)
77      ! changement pour t et q      ! changement pour t et q
78    
79      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
# Line 83  contains Line 82  contains
82      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
83    
84      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
85      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
86      ! le bas) à la surface      ! vers le bas) à la surface
87    
88      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
89      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
90    
91      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(:, :), flux_v(:, :) ! (klon, nbsrf)
92      ! tension du vent (flux turbulent de vent) à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
93    
94      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
95      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
96    
97      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      ! Ocean slab:
98      ! dflux_t derive du flux sensible      REAL, INTENT(out):: dflux_t(klon) ! derive du flux sensible
99      ! dflux_q derive du flux latent      REAL, INTENT(out):: dflux_q(klon) ! derive du flux latent
     ! IM "slab" ocean  
100    
101      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
102      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
# Line 125  contains Line 123  contains
123      ! flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
124      ! hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
125    
126      real ffonte(klon, nbsrf)      real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige
127      ! ffonte----Flux thermique utilise pour fondre la neige      REAL, intent(inout):: run_off_lic_0(:) ! (klon)
128      REAL run_off_lic_0(klon)  
129        REAL, intent(out):: albsol(:) ! (klon)
130        ! albedo du sol total, visible, moyen par maille
131    
132        REAL, intent(in):: sollw(:) ! (klon)
133        ! surface net downward longwave flux, in W m-2
134    
135        REAL, intent(in):: solsw(:) ! (klon)
136        ! surface net downward shortwave flux, in W m-2
137    
138        REAL, intent(in):: tsol(:) ! (klon)
139    
140      ! Local:      ! Local:
141    
142      LOGICAL:: firstcal = .true.      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
143        REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
144    
145      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
146      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
147      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
148    
149      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
150      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon), y_run_off_lic(klon)
151        REAL run_off_lic(klon) ! ruissellement total
152      REAL rugmer(klon)      REAL rugmer(klon)
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
154      REAL yts(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypctsrf(klon), yz0_new(klon)
155      real yrugos(klon) ! longueur de rugosite (en m)      real yrugos(klon) ! longueur de rugosite (en m)
156      REAL yalb(klon)      REAL yalb(klon)
157      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
158      real yqsol(klon) ! column-density of water in soil, in kg m-2      real yqsol(klon) ! column-density of water in soil, in kg m-2
159      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down      REAL yrain_fall(klon) ! liquid water mass flux (kg / m2 / s), positive down
160      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down      REAL ysnow_fall(klon) ! solid water mass flux (kg / m2 / s), positive down
161      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), radsol(klon), yrugoro(klon)
162      REAL yfluxlat(klon)      REAL yfluxlat(klon)
163      REAL y_d_ts(klon)      REAL y_d_ts(klon)
164      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
# Line 184  contains Line 194  contains
194      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
195      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
196      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
197        REAL zgeo1(klon)
     REAL qairsol(klon), zgeo1(klon)  
198      REAL rugo1(klon)      REAL rugo1(klon)
199      REAL zgeop(klon, klev)      REAL zgeop(klon, klev)
200    
201      !------------------------------------------------------------      !------------------------------------------------------------
202    
203        albsol = sum(falbe * pctsrf, dim = 2)
204    
205        ! R\'epartition sous maille des flux longwave et shortwave
206        ! R\'epartition du longwave par sous-surface lin\'earis\'ee
207    
208        forall (nsrf = 1:nbsrf)
209           fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
210                * (tsol - ftsol(:, nsrf))
211           fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
212        END forall
213    
214      ytherm = 0.      ytherm = 0.
215    
216      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
# Line 205  contains Line 225  contains
225      cdragm = 0.      cdragm = 0.
226      dflux_t = 0.      dflux_t = 0.
227      dflux_q = 0.      dflux_q = 0.
     ypct = 0.  
     yqsurf = 0.  
     yrain_f = 0.  
     ysnow_f = 0.  
228      yrugos = 0.      yrugos = 0.
229      ypaprs = 0.      ypaprs = 0.
230      ypplay = 0.      ypplay = 0.
231      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
232      yrugoro = 0.      yrugoro = 0.
233      d_ts = 0.      d_ts = 0.
234      flux_t = 0.      flux_t = 0.
# Line 232  contains Line 242  contains
242      d_v = 0.      d_v = 0.
243      coefh = 0.      coefh = 0.
244      fqcalving = 0.      fqcalving = 0.
245        run_off_lic = 0.
246    
247      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
248      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
249      ! (\`a affiner)      ! (\`a affiner).
250    
251      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
252      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
# Line 250  contains Line 261  contains
261      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
262    
263      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
264         ! Chercher les indices :         ! Define ni and knon:
265    
266         ni = 0         ni = 0
267         knon = 0         knon = 0
268    
269         DO i = 1, klon         DO i = 1, klon
270            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
271            ! "potentielles"            ! "potentielles"
# Line 263  contains Line 276  contains
276         END DO         END DO
277    
278         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
279            DO j = 1, knon            ypctsrf(:knon) = pctsrf(ni(:knon), nsrf)
280               i = ni(j)            yts(:knon) = ftsol(ni(:knon), nsrf)
281               ypct(j) = pctsrf(i, nsrf)            snow(:knon) = fsnow(ni(:knon), nsrf)
282               yts(j) = ftsol(i, nsrf)            yqsurf(:knon) = fqsurf(ni(:knon), nsrf)
283               snow(j) = fsnow(i, nsrf)            yalb(:knon) = falbe(ni(:knon), nsrf)
284               yqsurf(j) = qsurf(i, nsrf)            yrain_fall(:knon) = rain_fall(ni(:knon))
285               yalb(j) = falbe(i, nsrf)            ysnow_fall(:knon) = snow_fall(ni(:knon))
286               yrain_f(j) = rain_fall(i)            yagesno(:knon) = agesno(ni(:knon), nsrf)
287               ysnow_f(j) = snow_f(i)            yrugos(:knon) = frugs(ni(:knon), nsrf)
288               yagesno(j) = agesno(i, nsrf)            yrugoro(:knon) = rugoro(ni(:knon))
289               yrugos(j) = frugs(i, nsrf)            radsol(:knon) = fsolsw(ni(:knon), nsrf) + fsollw(ni(:knon), nsrf)
290               yrugoro(j) = rugoro(i)            ypaprs(:knon, klev + 1) = paprs(ni(:knon), klev + 1)
291               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)            y_run_off_lic_0(:knon) = run_off_lic_0(ni(:knon))
              ypaprs(j, klev + 1) = paprs(i, klev + 1)  
              y_run_off_lic_0(j) = run_off_lic_0(i)  
           END DO  
292    
293            ! For continent, copy soil water content            ! For continent, copy soil water content
294            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
# Line 289  contains Line 299  contains
299               DO j = 1, knon               DO j = 1, knon
300                  i = ni(j)                  i = ni(j)
301                  ypaprs(j, k) = paprs(i, k)                  ypaprs(j, k) = paprs(i, k)
302                  ypplay(j, k) = pplay(i, k)                  ypplay(j, k) = play(i, k)
303                  ydelp(j, k) = delp(i, k)                  ydelp(j, k) = delp(i, k)
304                  yu(j, k) = u(i, k)                  yu(j, k) = u(i, k)
305                  yv(j, k) = v(i, k)                  yv(j, k) = v(i, k)
# Line 325  contains Line 335  contains
335               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
336            END IF            END IF
337    
338            IF (iflag_pbl >= 6) then            IF (iflag_pbl >= 6) yq2(:knon, :) = q2(ni(:knon), :, nsrf)
339               DO k = 1, klev + 1            call coef_diff_turb(nsrf, ni(:knon), ypaprs(:knon, :), &
                 DO j = 1, knon  
                    i = ni(j)  
                    yq2(j, k) = q2(i, k, nsrf)  
                 END DO  
              END DO  
           end IF  
   
           call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &  
340                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
341                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
342                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
343    
344            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
345                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
346                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
347                 y_flux_u(:knon))                 y_flux_u(:knon))
348            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
349                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
350                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
351                 y_flux_v(:knon))                 y_flux_v(:knon))
352    
353            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, nsrf, ni(:knon), ytsoil(:knon, :), yqsol(:knon), &
354            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &
355                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos(:knon), &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
356                 yrugoro(:knon), yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
357                 ycdragh(:knon), yt(:knon, :), yq(:knon, :), yts(:knon), &                 ydelp(:knon, :), radsol(:knon), yalb(:knon), snow(:knon), &
358                 ypaprs(:knon, :), ypplay(:knon, :), ydelp, yrads(:knon), &                 yqsurf(:knon), yrain_fall(:knon), ysnow_fall(:knon), &
359                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
                yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &  
360                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
361                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
362                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
363                 y_ffonte, y_run_off_lic_0)                 y_ffonte(:knon), y_run_off_lic_0(:knon), y_run_off_lic(:knon))
364    
365            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
366    
367            yrugm = 0.            yrugm = 0.
368    
369            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
370               DO j = 1, knon               DO j = 1, knon
371                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &
# Line 371  contains Line 374  contains
374                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
375               END DO               END DO
376            END IF            END IF
           DO j = 1, knon  
              y_dflux_t(j) = y_dflux_t(j) * ypct(j)  
              y_dflux_q(j) = y_dflux_q(j) * ypct(j)  
           END DO  
377    
378            DO k = 1, klev            DO k = 1, klev
379               DO j = 1, knon               DO j = 1, knon
380                  i = ni(j)                  i = ni(j)
381                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypctsrf(j)
382                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypctsrf(j)
383                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypctsrf(j)
384                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypctsrf(j)
385               END DO               END DO
386            END DO            END DO
387    
# Line 391  contains Line 390  contains
390            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
391            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
392    
           evap(:, nsrf) = -flux_q(:, nsrf)  
   
393            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
394            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
395            qsurf(:, nsrf) = 0.            fqsurf(:, nsrf) = 0.
396            frugs(:, nsrf) = 0.            frugs(:, nsrf) = 0.
397            DO j = 1, knon            DO j = 1, knon
398               i = ni(j)               i = ni(j)
399               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
400               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
401               fsnow(i, nsrf) = snow(j)               fsnow(i, nsrf) = snow(j)
402               qsurf(i, nsrf) = yqsurf(j)               fqsurf(i, nsrf) = yqsurf(j)
403               frugs(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
404               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
405               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
# Line 412  contains Line 409  contains
409               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
410               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
411               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
412               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypctsrf(j)
413               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypctsrf(j)
414               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypctsrf(j)
415               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypctsrf(j)
416            END DO            END DO
417            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
418               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 423  contains Line 420  contains
420               DO j = 1, knon               DO j = 1, knon
421                  i = ni(j)                  i = ni(j)
422                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
423                    run_off_lic(i) = y_run_off_lic(j)
424               END DO               END DO
425            END IF            END IF
426    
# Line 440  contains Line 438  contains
438            END DO            END DO
439    
440            forall (k = 2:klev) coefh(ni(:knon), k) &            forall (k = 2:klev) coefh(ni(:knon), k) &
441                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypctsrf(:knon)
442    
443            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
444    
# Line 459  contains Line 457  contains
457               END IF               END IF
458               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
459               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
   
              qairsol(j) = yqsurf(j)  
460            END DO            END DO
461    
462            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
463                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &                 zgeo1, tairsol, yqsurf(:knon), rugo1, psfce, patm, yt2m, yq2m, &
464                 yq10m, wind10m(:knon), ustar(:knon))                 yt10m, yq10m, wind10m(:knon), ustar(:knon))
465    
466            DO j = 1, knon            DO j = 1, knon
467               i = ni(j)               i = ni(j)
# Line 479  contains Line 475  contains
475            END DO            END DO
476    
477            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
478                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
479                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
480                   ytherm, ylcl)
481    
482            DO j = 1, knon            DO j = 1, knon
483               i = ni(j)               i = ni(j)
# Line 493  contains Line 490  contains
490               therm(i, nsrf) = ytherm(j)               therm(i, nsrf) = ytherm(j)
491            END DO            END DO
492    
493            DO j = 1, knon            IF (iflag_pbl >= 6) q2(ni(:knon), :, nsrf) = yq2(:knon, :)
              DO k = 1, klev + 1  
                 i = ni(j)  
                 q2(i, k, nsrf) = yq2(j, k)  
              END DO  
           END DO  
494         else         else
495            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
496         end IF if_knon         end IF if_knon
# Line 509  contains Line 501  contains
501      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
502      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
503    
504      firstcal = .false.      CALL histwrite_phy("run_off_lic", run_off_lic)
505    
506    END SUBROUTINE pbl_surface    END SUBROUTINE pbl_surface
507    
Legend:
Removed from v.282  
changed lines
  Added in v.309
  ViewVC Help
Powered by ViewVC 1.1.21