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

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

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

trunk/phylmd/clmain.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 310 by guez, Thu Sep 27 16:29:06 2018 UTC
# Line 1  Line 1 
1  module clmain_m  module pbl_surface_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &    SUBROUTINE pbl_surface(pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, fluxlat, &         cdhmax, ftsoil, qsol, paprs, play, fsnow, fqsurf, falbe, fluxlat, &
9         rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, d_q, &         rain_fall, snow_fall, frugs, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, &
10         d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, &
11         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/08/18      ! 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 20  contains Line 22  contains
22      ! ne tient pas compte de la diff\'erentiation des sous-fractions      ! ne tient pas compte de la diff\'erentiation des sous-fractions
23      ! de sol.      ! de sol.
24    
25      use clcdrag_m, only: clcdrag      use cdrag_m, only: cdrag
26      use clqh_m, only: clqh      use clqh_m, only: clqh
27      use clvent_m, only: clvent      use clvent_m, only: clvent
28      use coef_diff_turb_m, only: coef_diff_turb      use coef_diff_turb_m, only: coef_diff_turb
29      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
31      USE dimphy, ONLY: klev, klon, zmasq      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
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)
47      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
48      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
49      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
50      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)  
51        REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf)
52        ! skin temperature of surface fraction, in K
53    
54      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
55    
56      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
# Line 55  contains Line 60  contains
60      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
61    
62      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
63      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: play(klon, klev) ! pression au milieu de couche (Pa)
64      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
65      REAL qsurf(klon, nbsrf)      REAL, INTENT(inout):: fqsurf(klon, nbsrf)
     REAL evap(klon, nbsrf)  
66      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
67      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
68    
69      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
70      ! liquid water mass flux (kg / m2 / s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
71    
72      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_fall(klon)
73      ! solid water mass flux (kg / m2 / s), positive down      ! solid water mass flux (kg / m2 / s), positive down
74    
     REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)  
75      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
76      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
77      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
78    
79      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(:, :), d_q(:, :) ! (klon, klev)
80      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "q"  
81    
82      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
83      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 83  contains Line 85  contains
85      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
86    
87      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
88      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
89      ! le bas) à la surface      ! vers le bas) à la surface
90    
91      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
92      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
93    
94      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(:, :), flux_v(:, :) ! (klon, nbsrf)
95      ! tension du vent (flux turbulent de vent) à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
96    
97      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
98      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
99    
100      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      ! Ocean slab:
101      ! dflux_t derive du flux sensible      REAL, INTENT(out):: dflux_t(klon) ! derive du flux sensible
102      ! dflux_q derive du flux latent      REAL, INTENT(out):: dflux_q(klon) ! derive du flux latent
     ! IM "slab" ocean  
103    
104      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
105      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
# Line 120  contains Line 121  contains
121      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
122      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
123      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
124      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
125      ! ffonte----Flux thermique utilise pour fondre la neige      REAL, intent(out):: fqcalving(klon, nbsrf)
126      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! flux d'eau "perdue" par la surface et necessaire pour limiter la
127      !           hauteur de neige, en kg / m2 / s      ! hauteur de neige, en kg / m2 / s
128      REAL run_off_lic_0(klon)  
129        real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige
130        REAL, intent(inout):: run_off_lic_0(:) ! (klon)
131    
132        REAL, intent(out):: albsol(:) ! (klon)
133        ! albedo du sol total, visible, moyen par maille
134    
135        REAL, intent(in):: sollw(:) ! (klon)
136        ! surface net downward longwave flux, in W m-2
137    
138        REAL, intent(in):: solsw(:) ! (klon)
139        ! surface net downward shortwave flux, in W m-2
140    
141        REAL, intent(in):: tsol(:) ! (klon)
142    
143      ! Local:      ! Local:
144    
145      LOGICAL:: firstcal = .true.      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous-surface
146        REAL fsolsw(klon, nbsrf) ! flux solaire absorb\'e pour chaque sous-surface
147    
148      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
149      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
150      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
151    
152      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
153      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon), y_run_off_lic(klon)
154        REAL run_off_lic(klon) ! ruissellement total
155      REAL rugmer(klon)      REAL rugmer(klon)
156      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
157      REAL yts(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypctsrf(klon), yz0_new(klon)
158      real yrugos(klon) ! longeur de rugosite (en m)      real yrugos(klon) ! longueur de rugosite (en m)
159      REAL yalb(klon)      REAL yalb(klon)
160      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
161      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
162      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
163      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
164      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), radsol(klon), yrugoro(klon)
165      REAL yfluxlat(klon)      REAL yfluxlat(klon)
166      REAL y_d_ts(klon)      REAL y_d_ts(klon)
167      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
# Line 181  contains Line 197  contains
197      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
198      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
199      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
200        REAL zgeo1(klon)
     REAL qairsol(klon), zgeo1(klon)  
201      REAL rugo1(klon)      REAL rugo1(klon)
202      REAL zgeop(klon, klev)      REAL zgeop(klon, klev)
203    
204      !------------------------------------------------------------      !------------------------------------------------------------
205    
206        albsol = sum(falbe * pctsrf, dim = 2)
207    
208        ! R\'epartition sous maille des flux longwave et shortwave
209        ! R\'epartition du longwave par sous-surface lin\'earis\'ee
210    
211        forall (nsrf = 1:nbsrf)
212           fsollw(:, nsrf) = sollw + 4. * RSIGMA * tsol**3 &
213                * (tsol - ftsol(:, nsrf))
214           fsolsw(:, nsrf) = solsw * (1. - falbe(:, nsrf)) / (1. - albsol)
215        END forall
216    
217      ytherm = 0.      ytherm = 0.
218    
219      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
# Line 202  contains Line 228  contains
228      cdragm = 0.      cdragm = 0.
229      dflux_t = 0.      dflux_t = 0.
230      dflux_q = 0.      dflux_q = 0.
     ypct = 0.  
     yqsurf = 0.  
     yrain_f = 0.  
     ysnow_f = 0.  
231      yrugos = 0.      yrugos = 0.
232      ypaprs = 0.      ypaprs = 0.
233      ypplay = 0.      ypplay = 0.
234      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
235      yrugoro = 0.      yrugoro = 0.
236      d_ts = 0.      d_ts = 0.
237      flux_t = 0.      flux_t = 0.
# Line 228  contains Line 244  contains
244      d_u = 0.      d_u = 0.
245      d_v = 0.      d_v = 0.
246      coefh = 0.      coefh = 0.
247        fqcalving = 0.
248        run_off_lic = 0.
249    
250      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
251      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
252      ! (\`a affiner)      ! (\`a affiner).
253    
254      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
255      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
# Line 246  contains Line 264  contains
264      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
265    
266      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
267         ! Chercher les indices :         ! Define ni and knon:
268    
269         ni = 0         ni = 0
270         knon = 0         knon = 0
271    
272         DO i = 1, klon         DO i = 1, klon
273            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
274            ! "potentielles"            ! "potentielles"
# Line 259  contains Line 279  contains
279         END DO         END DO
280    
281         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
282            DO j = 1, knon            ypctsrf(:knon) = pctsrf(ni(:knon), nsrf)
283               i = ni(j)            yts(:knon) = ftsol(ni(:knon), nsrf)
284               ypct(j) = pctsrf(i, nsrf)            snow(:knon) = fsnow(ni(:knon), nsrf)
285               yts(j) = ftsol(i, nsrf)            yqsurf(:knon) = fqsurf(ni(:knon), nsrf)
286               snow(j) = fsnow(i, nsrf)            yalb(:knon) = falbe(ni(:knon), nsrf)
287               yqsurf(j) = qsurf(i, nsrf)            yrain_fall(:knon) = rain_fall(ni(:knon))
288               yalb(j) = falbe(i, nsrf)            ysnow_fall(:knon) = snow_fall(ni(:knon))
289               yrain_f(j) = rain_fall(i)            yagesno(:knon) = agesno(ni(:knon), nsrf)
290               ysnow_f(j) = snow_f(i)            yrugos(:knon) = frugs(ni(:knon), nsrf)
291               yagesno(j) = agesno(i, nsrf)            yrugoro(:knon) = rugoro(ni(:knon))
292               yrugos(j) = frugs(i, nsrf)            radsol(:knon) = fsolsw(ni(:knon), nsrf) + fsollw(ni(:knon), nsrf)
293               yrugoro(j) = rugoro(i)            ypaprs(:knon, klev + 1) = paprs(ni(:knon), klev + 1)
294               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  
295    
296            ! For continent, copy soil water content            ! For continent, copy soil water content
297            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
# Line 285  contains Line 302  contains
302               DO j = 1, knon               DO j = 1, knon
303                  i = ni(j)                  i = ni(j)
304                  ypaprs(j, k) = paprs(i, k)                  ypaprs(j, k) = paprs(i, k)
305                  ypplay(j, k) = pplay(i, k)                  ypplay(j, k) = play(i, k)
306                  ydelp(j, k) = delp(i, k)                  ydelp(j, k) = delp(i, k)
307                  yu(j, k) = u(i, k)                  yu(j, k) = u(i, k)
308                  yv(j, k) = v(i, k)                  yv(j, k) = v(i, k)
# Line 305  contains Line 322  contains
322                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))
323            ENDDO            ENDDO
324    
325            CALL clcdrag(nsrf, yu(:knon, 1), yv(:knon, 1), yt(:knon, 1), &            CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
326                 yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &                 yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
327                 yrugos(:knon), ycdragm(:knon), ycdragh(:knon))                 yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
328                   ycdragh(:knon))
329    
330            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
331               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
# Line 320  contains Line 338  contains
338               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
339            END IF            END IF
340    
341            IF (iflag_pbl >= 6) then            IF (iflag_pbl >= 6) yq2(:knon, :) = q2(ni(:knon), :, nsrf)
342               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, :), &  
343                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
344                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
345                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
346    
347            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
348                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
349                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
350                 y_flux_u(:knon))                 y_flux_u(:knon))
351            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
352                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
353                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
354                 y_flux_v(:knon))                 y_flux_v(:knon))
355    
356            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, nsrf, ni(:knon), ytsoil(:knon, :), yqsol(:knon), &
357            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &
358                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
359                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
360                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &                 ydelp(:knon, :), radsol(:knon), yalb(:knon), snow(:knon), &
361                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 yqsurf(:knon), yrain_fall(:knon), ysnow_fall(:knon), &
362                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
363                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
364                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
365                 y_run_off_lic_0)                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
366                   y_ffonte(:knon), y_run_off_lic_0(:knon), y_run_off_lic(:knon))
367    
368            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
369    
370            yrugm = 0.            yrugm = 0.
371    
372            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
373               DO j = 1, knon               DO j = 1, knon
374                  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 364  contains Line 377  contains
377                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
378               END DO               END DO
379            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  
380    
381            DO k = 1, klev            DO k = 1, klev
382               DO j = 1, knon               DO j = 1, knon
383                  i = ni(j)                  i = ni(j)
384                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypctsrf(j)
385                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypctsrf(j)
386                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypctsrf(j)
387                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypctsrf(j)
388               END DO               END DO
389            END DO            END DO
390    
# Line 384  contains Line 393  contains
393            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
394            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
395    
           evap(:, nsrf) = -flux_q(:, nsrf)  
   
396            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
397            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
398            qsurf(:, nsrf) = 0.            fqsurf(:, nsrf) = 0.
399            frugs(:, nsrf) = 0.            frugs(:, nsrf) = 0.
400            DO j = 1, knon            DO j = 1, knon
401               i = ni(j)               i = ni(j)
402               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
403               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
404               fsnow(i, nsrf) = snow(j)               fsnow(i, nsrf) = snow(j)
405               qsurf(i, nsrf) = yqsurf(j)               fqsurf(i, nsrf) = yqsurf(j)
406               frugs(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
407               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
408               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
# Line 405  contains Line 412  contains
412               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
413               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
414               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
415               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypctsrf(j)
416               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypctsrf(j)
417               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypctsrf(j)
418               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypctsrf(j)
419            END DO            END DO
420            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
421               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 416  contains Line 423  contains
423               DO j = 1, knon               DO j = 1, knon
424                  i = ni(j)                  i = ni(j)
425                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
426                    run_off_lic(i) = y_run_off_lic(j)
427               END DO               END DO
428            END IF            END IF
429    
# Line 433  contains Line 441  contains
441            END DO            END DO
442    
443            forall (k = 2:klev) coefh(ni(:knon), k) &            forall (k = 2:klev) coefh(ni(:knon), k) &
444                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)                 = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypctsrf(:knon)
445    
446            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
447    
# Line 452  contains Line 460  contains
460               END IF               END IF
461               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
462               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
   
              qairsol(j) = yqsurf(j)  
463            END DO            END DO
464    
465            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
466                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, yqsurf(:knon), rugo1, psfce, patm, yt2m, yq2m, &
467                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))                 yt10m, yq10m, wind10m(:knon), ustar(:knon))
468    
469            DO j = 1, knon            DO j = 1, knon
470               i = ni(j)               i = ni(j)
# Line 472  contains Line 478  contains
478            END DO            END DO
479    
480            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
481                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
482                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
483                   ytherm, ylcl)
484    
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
# Line 486  contains Line 493  contains
493               therm(i, nsrf) = ytherm(j)               therm(i, nsrf) = ytherm(j)
494            END DO            END DO
495    
496            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  
497         else         else
498            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
499         end IF if_knon         end IF if_knon
# Line 502  contains Line 504  contains
504      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
505      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
506    
507      firstcal = .false.      CALL histwrite_phy("run_off_lic", run_off_lic)
508    
509    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
510    
511  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.254  
changed lines
  Added in v.310
  ViewVC Help
Powered by ViewVC 1.1.21