/[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/Sources/phylmd/clmain.f revision 246 by guez, Wed Nov 15 13:56:45 2017 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 305 by guez, Tue Sep 11 11:08:38 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, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, falbe, fluxlat, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         rain_fall, snow_fall, fsolsw, fsollw, frugs, agesno, rugoro, d_t, d_q, &
10         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &         d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
11         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, &         dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &
12         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)
        trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)  
13    
14      ! 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
15      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS)
16        ! Date: Aug. 18th, 1993
17      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
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
# Line 21  contains Line 21  contains
21      ! ne tient pas compte de la diff\'erentiation des sous-fractions      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! de sol.      ! de sol.
23    
24        use cdrag_m, only: cdrag
25      use clqh_m, only: clqh      use clqh_m, only: clqh
26      use clvent_m, only: clvent      use clvent_m, only: clvent
27      use coefkz_m, only: coefkz      use coef_diff_turb_m, only: coef_diff_turb
     use coefkzmin_m, only: coefkzmin  
     use coefkz2_m, only: coefkz2  
28      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
29      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
30      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
32      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
33        USE histwrite_phy_m, ONLY: histwrite_phy
34      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
35      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
36        use phyetat0_m, only: zmasq
37      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
38      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg
39      use time_phylmdz, only: itap      use time_phylmdz, only: itap
     use ustarhb_m, only: ustarhb  
     use yamada4_m, only: yamada4  
   
     REAL, INTENT(IN):: dtime ! interval du temps (secondes)  
40    
41      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
42      ! tableau des pourcentages de surface de chaque maille      ! tableau des pourcentages de surface de chaque maille
# Line 51  contains Line 48  contains
48      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
49      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
50      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
     REAL, INTENT(IN):: ksta, ksta_ter  
     LOGICAL, INTENT(IN):: ok_kzmin  
51    
52      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
53      ! soil temperature of surface fraction      ! soil temperature of surface fraction
# Line 63  contains Line 58  contains
58      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
59      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
60      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
61      REAL qsurf(klon, nbsrf)      REAL, INTENT(inout):: qsurf(klon, nbsrf)
     REAL evap(klon, nbsrf)  
62      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
63      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
64    
65      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
66      ! liquid water mass flux (kg / m2 / s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
67    
68      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_fall(klon)
69      ! solid water mass flux (kg / m2 / s), positive down      ! solid water mass flux (kg / m2 / s), positive down
70    
71      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
# Line 79  contains Line 73  contains
73      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
74      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
75    
76      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(:, :), d_q(:, :) ! (klon, klev)
77      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "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)
80      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 89  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
# Line 101  contains Line 94  contains
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 117  contains
117      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
118      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
119      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
     REAL trmb1(klon, nbsrf)  
     ! trmb1-------deep_cape  
     REAL trmb2(klon, nbsrf)  
     ! trmb2--------inhibition  
     REAL trmb3(klon, nbsrf)  
     ! trmb3-------Point Omega  
120      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
     ! ffonte----Flux thermique utilise pour fondre la neige  
     ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la  
     !           hauteur de neige, en kg / m2 / s  
     REAL run_off_lic_0(klon)  
121    
122      ! Local:      REAL, intent(out):: fqcalving(klon, nbsrf)
123        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
124        ! hauteur de neige, en kg / m2 / s
125    
126      LOGICAL:: firstcal = .true.      real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige
127        REAL, intent(inout):: run_off_lic_0(:) ! (klon)
128    
129        ! Local:
130    
131      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
132      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
133      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
134    
135      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
136      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon), y_run_off_lic(klon)
137        REAL run_off_lic(klon) ! ruissellement total
138      REAL rugmer(klon)      REAL rugmer(klon)
139      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
140      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
141        real yrugos(klon) ! longueur de rugosite (en m)
142      REAL yalb(klon)      REAL yalb(klon)
143      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
144      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
145      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
146      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
147      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
148      REAL yfluxlat(klon)      REAL yfluxlat(klon)
149      REAL y_d_ts(klon)      REAL y_d_ts(klon)
# Line 169  contains Line 157  contains
157      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
158      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
159      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
     REAL ycoefm0(klon, 2:klev), ycoefh0(klon, 2:klev)  
     REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)  
160      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
161      REAL delp(klon, klev)      REAL delp(klon, klev)
162      INTEGER i, k, nsrf      INTEGER i, k, nsrf
# Line 191  contains Line 177  contains
177      REAL ycteicl(klon)      REAL ycteicl(klon)
178      REAL ypblt(klon)      REAL ypblt(klon)
179      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
180      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
181      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
182      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
183        REAL zgeo1(klon)
     REAL qairsol(klon), zgeo1(klon)  
184      REAL rugo1(klon)      REAL rugo1(klon)
185        REAL zgeop(klon, klev)
186    
187      !------------------------------------------------------------      !------------------------------------------------------------
188    
# Line 218  contains Line 201  contains
201      dflux_t = 0.      dflux_t = 0.
202      dflux_q = 0.      dflux_q = 0.
203      ypct = 0.      ypct = 0.
     yqsurf = 0.  
     yrain_f = 0.  
     ysnow_f = 0.  
204      yrugos = 0.      yrugos = 0.
205      ypaprs = 0.      ypaprs = 0.
206      ypplay = 0.      ypplay = 0.
207      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
208      yrugoro = 0.      yrugoro = 0.
209      d_ts = 0.      d_ts = 0.
210      flux_t = 0.      flux_t = 0.
# Line 243  contains Line 217  contains
217      d_u = 0.      d_u = 0.
218      d_v = 0.      d_v = 0.
219      coefh = 0.      coefh = 0.
220        fqcalving = 0.
221        run_off_lic = 0.
222    
223      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
224      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
225      ! (\`a affiner)      ! (\`a affiner).
226    
227      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
228      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
# Line 261  contains Line 237  contains
237      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
238    
239      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
240         ! Chercher les indices :         ! Define ni and knon:
241          
242         ni = 0         ni = 0
243         knon = 0         knon = 0
244    
245         DO i = 1, klon         DO i = 1, klon
246            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
247            ! "potentielles"            ! "potentielles"
# Line 281  contains Line 259  contains
259               snow(j) = fsnow(i, nsrf)               snow(j) = fsnow(i, nsrf)
260               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
261               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
262               yrain_f(j) = rain_fall(i)               yrain_fall(j) = rain_fall(i)
263               ysnow_f(j) = snow_f(i)               ysnow_fall(j) = snow_fall(i)
264               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
265               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
266               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
# Line 309  contains Line 287  contains
287               END DO               END DO
288            END DO            END DO
289    
290            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            ! Calculer les géopotentiels de chaque couche:
291                 yrugos, yu, yv, yt, yq, yqsurf(:knon), ycoefm(:knon, :), &  
292                 ycoefh(:knon, :), ycdragm(:knon), ycdragh(:knon))            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
293                   + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
294    
295              DO k = 2, klev
296                 zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
297                      * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
298                      * (ypplay(:knon, k - 1) - ypplay(:knon, k))
299              ENDDO
300    
301              CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
302                   yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
303                   yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
304                   ycdragh(:knon))
305    
306            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
              CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, :), &  
                   ycoefh0(:knon, :))  
              ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))  
              ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))  
307               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
308               ycdragh(:knon) = max(ycdragh(:knon), 0.)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
309            END IF            end IF
310    
311            ! on met un seuil pour ycdragm et ycdragh            ! on met un seuil pour ycdragm et ycdragh
312            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
# Line 328  contains Line 314  contains
314               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
315            END IF            END IF
316    
317            IF (ok_kzmin) THEN            IF (iflag_pbl >= 6) yq2(:knon, :) = q2(ni(:knon), :, nsrf)
318               ! Calcul d'une diffusion minimale pour les conditions tres stables            call coef_diff_turb(nsrf, ni(:knon), ypaprs(:knon, :), &
319               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
320                    ycdragm(:knon), ycoefh0(:knon, :))                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
321               ycoefm0(:knon, :) = ycoefh0(:knon, :)                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
322               ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))            
323               ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
           END IF  
   
           IF (iflag_pbl >= 6) THEN  
              ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et  
              ! Fr\'ed\'eric Hourdin  
              yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &  
                   + ypplay(:knon, 1))) &  
                   * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg  
   
              DO k = 2, klev  
                 yzlay(:knon, k) = yzlay(:knon, k-1) &  
                      + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &  
                      / ypaprs(1:knon, k) &  
                      * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg  
              END DO  
   
              DO k = 1, klev  
                 yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &  
                      / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))  
              END DO  
   
              zlev(:knon, 1) = 0.  
              zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &  
                   - yzlay(:knon, klev - 1)  
   
              DO k = 2, klev  
                 zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))  
              END DO  
   
              DO k = 1, klev + 1  
                 DO j = 1, knon  
                    i = ni(j)  
                    yq2(j, k) = q2(i, k, nsrf)  
                 END DO  
              END DO  
   
              ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))  
              CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &  
                   yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &  
                   ycoefm(:knon, :), ycoefh(:knon, :), ustar(:knon))  
           END IF  
   
           CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &  
324                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
325                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
326                 y_flux_u(:knon))                 y_flux_u(:knon))
327            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
328                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
329                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
330                 y_flux_v(:knon))                 y_flux_v(:knon))
331    
332            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, nsrf, ni(:knon), ytsoil(:knon, :), yqsol(:knon), &
333            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &
334                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
335                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
336                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &                 ydelp(:knon, :), yrads(:knon), yalb(:knon), snow(:knon), &
337                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 yqsurf(:knon), yrain_fall(:knon), ysnow_fall(:knon), &
338                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
339                 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), &
340                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
341                 y_run_off_lic_0)                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
342                   y_ffonte(:knon), y_run_off_lic_0(:knon), y_run_off_lic(:knon))
343    
344            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
345    
346            yrugm = 0.            yrugm = 0.
347    
348            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
349               DO j = 1, knon               DO j = 1, knon
350                  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 407  contains Line 353  contains
353                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
354               END DO               END DO
355            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  
356    
357            DO k = 1, klev            DO k = 1, klev
358               DO j = 1, knon               DO j = 1, knon
# Line 427  contains Line 369  contains
369            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
370            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
371    
           evap(:, nsrf) = -flux_q(:, nsrf)  
   
372            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
373            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
374            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
# Line 450  contains Line 390  contains
390               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
391               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
392               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
393               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
394               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
395            END DO            END DO
396            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
397               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 459  contains Line 399  contains
399               DO j = 1, knon               DO j = 1, knon
400                  i = ni(j)                  i = ni(j)
401                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
402                    run_off_lic(i) = y_run_off_lic(j)
403               END DO               END DO
404            END IF            END IF
405    
# Line 495  contains Line 436  contains
436               END IF               END IF
437               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
438               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
   
              qairsol(j) = yqsurf(j)  
439            END DO            END DO
440    
441            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
442                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, yqsurf(:knon), rugo1, psfce, patm, yt2m, yq2m, &
443                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))                 yt10m, yq10m, wind10m(:knon), ustar(:knon))
444    
445            DO j = 1, knon            DO j = 1, knon
446               i = ni(j)               i = ni(j)
# Line 515  contains Line 454  contains
454            END DO            END DO
455    
456            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
457                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
458                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
459                   ytherm, ylcl)
460    
461            DO j = 1, knon            DO j = 1, knon
462               i = ni(j)               i = ni(j)
# Line 527  contains Line 467  contains
467               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
468               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
469               therm(i, nsrf) = ytherm(j)               therm(i, nsrf) = ytherm(j)
              trmb1(i, nsrf) = ytrmb1(j)  
              trmb2(i, nsrf) = ytrmb2(j)  
              trmb3(i, nsrf) = ytrmb3(j)  
470            END DO            END DO
471    
472            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  
473         else         else
474            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
475         end IF if_knon         end IF if_knon
# Line 548  contains Line 480  contains
480      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
481      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
482    
483      firstcal = .false.      CALL histwrite_phy("run_off_lic", run_off_lic)
484    
485    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
486    
487  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.246  
changed lines
  Added in v.305
  ViewVC Help
Powered by ViewVC 1.1.21