/[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 227 by guez, Thu Nov 2 15:47:03 2017 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 293 by guez, Wed Jul 25 16:16:53 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(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, &
8         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdmmax, cdhmax, ftsoil, qsol, paprs, pplay, fsnow, qsurf, evap, falbe, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, agesno, rugoro, d_t, &
10         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
11         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &         q2, 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), date: 1993 Aug. 18th
16      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
17    
18      ! 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 20  contains
20      ! ne tient pas compte de la diff\'erentiation des sous-fractions      ! ne tient pas compte de la diff\'erentiation des sous-fractions
21      ! de sol.      ! de sol.
22    
23        use cdrag_m, only: cdrag
24      use clqh_m, only: clqh      use clqh_m, only: clqh
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coefkz_m, only: coefkz      use coef_diff_turb_m, only: coef_diff_turb
     use coefkzmin_m, only: coefkzmin  
27      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
28      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
29      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon
30      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
31      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
32      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
33      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
34        use phyetat0_m, only: zmasq
35      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
36      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg
37      use time_phylmdz, only: itap      use time_phylmdz, only: itap
     use ustarhb_m, only: ustarhb  
     use vdif_kcay_m, only: vdif_kcay  
     use yamada4_m, only: yamada4  
38    
39      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
40    
# 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 79  contains Line 74  contains
74      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
75      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
76    
77      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(klon, klev), d_q(klon, klev)
78      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "q"  
79    
80      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
81      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 96  contains Line 90  contains
90      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
91    
92      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
93      ! tension du vent à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
94    
95      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
96      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
# Line 106  contains Line 100  contains
100      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
101      ! IM "slab" ocean      ! IM "slab" ocean
102    
103      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
104      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
105      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de      ! "coefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
106      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! ce champ sur les quatre sous-surfaces du mod\`ele.
107    
108      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
# Line 125  contains Line 119  contains
119      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
120      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
121      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  
122      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
123      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
124        REAL, intent(out):: fqcalving(klon, nbsrf)
125        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
126        ! hauteur de neige, en kg / m2 / s
127    
128        real ffonte(klon, nbsrf)
129      ! ffonte----Flux thermique utilise pour fondre la neige      ! 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  
130      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
131    
132      ! Local:      ! Local:
# Line 150  contains Line 141  contains
141      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
142      REAL rugmer(klon)      REAL rugmer(klon)
143      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
144      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
145        real yrugos(klon) ! longueur de rugosite (en m)
146      REAL yalb(klon)      REAL yalb(klon)
147      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
148      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
# Line 164  contains Line 156  contains
156      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
157      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
158      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
159      REAL coefh(klon, klev), coefm(klon, klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
160        real ycdragh(klon), ycdragm(klon)
161      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
162      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
163      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, klev), ycoefh0(klon, klev)  
   
     REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)  
     REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)  
     REAL ykmq(klon, klev + 1)  
164      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
165      REAL delp(klon, klev)      REAL delp(klon, klev)
166      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
167      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
168    
169      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
# Line 197  contains Line 181  contains
181      REAL ycteicl(klon)      REAL ycteicl(klon)
182      REAL ypblt(klon)      REAL ypblt(klon)
183      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
184      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
185      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
186      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
187    
188      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
189      REAL rugo1(klon)      REAL rugo1(klon)
190        REAL zgeop(klon, klev)
191    
192      !------------------------------------------------------------      !------------------------------------------------------------
193    
# Line 233  contains Line 215  contains
215      ydelp = 0.      ydelp = 0.
216      yu = 0.      yu = 0.
217      yv = 0.      yv = 0.
     yt = 0.  
218      yq = 0.      yq = 0.
     y_dflux_t = 0.  
     y_dflux_q = 0.  
219      yrugoro = 0.      yrugoro = 0.
220      d_ts = 0.      d_ts = 0.
221      flux_t = 0.      flux_t = 0.
# Line 248  contains Line 227  contains
227      d_q = 0.      d_q = 0.
228      d_u = 0.      d_u = 0.
229      d_v = 0.      d_v = 0.
230      ycoefh = 0.      coefh = 0.
231        fqcalving = 0.
232    
233      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
234      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
# Line 315  contains Line 295  contains
295               END DO               END DO
296            END DO            END DO
297    
298            ! calculer Cdrag et les coefficients d'echange            ! Calculer les géopotentiels de chaque couche:
           CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &  
                yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &  
                coefh(:knon, :))  
             
           IF (iflag_pbl == 1) THEN  
              CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)  
              coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))  
              coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))  
           END IF  
   
           ! on met un seuil pour coefm et coefh  
           IF (nsrf == is_oce) THEN  
              coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)  
              coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)  
           END IF  
   
           IF (ok_kzmin) THEN  
              ! Calcul d'une diffusion minimale pour les conditions tres stables  
              CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &  
                   coefm(:knon, 1), ycoefm0, ycoefh0)  
              coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))  
              coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))  
           END IF  
299    
300            IF (iflag_pbl >= 3) THEN            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
301               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et                 + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
              ! 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  
302    
303               DO k = 1, klev            DO k = 2, klev
304                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &               zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
305                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))                    * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
306               END DO                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))
307              ENDDO
308    
309              CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
310                   yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
311                   yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
312                   ycdragh(:knon))
313    
314               zlev(:knon, 1) = 0.            IF (iflag_pbl == 1) THEN
315               zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &               ycdragm(:knon) = max(ycdragm(:knon), 0.)
316                    - yzlay(:knon, klev - 1)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
317              end IF
318    
319               DO k = 2, klev            ! on met un seuil pour ycdragm et ycdragh
320                  zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))            IF (nsrf == is_oce) THEN
321               END DO               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
322                 ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
323              END IF
324    
325              IF (iflag_pbl >= 6) then
326               DO k = 1, klev + 1               DO k = 1, klev + 1
327                  DO j = 1, knon                  DO j = 1, knon
328                     i = ni(j)                     i = ni(j)
329                     yq2(j, k) = q2(i, k, nsrf)                     yq2(j, k) = q2(i, k, nsrf)
330                  END DO                  END DO
331               END DO               END DO
332              end IF
333    
334               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &
335                   ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
336               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
337                   ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
338               IF (iflag_pbl >= 11) THEN  
339                  CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
340                       coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
341                       iflag_pbl)                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
              ELSE  
                 CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &  
                      yu(:knon, :), yv(:knon, :), yteta(:knon, :), &  
                      coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &  
                      ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), iflag_pbl)  
              END IF  
   
              coefm(:knon, 2:) = ykmm(:knon, 2:klev)  
              coefh(:knon, 2:) = ykmn(:knon, 2:klev)  
           END IF  
   
           ! calculer la diffusion des vitesses "u" et "v"  
           CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &  
                coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &  
342                 y_flux_u(:knon))                 y_flux_u(:knon))
343            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
344                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
345                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
346                 y_flux_v(:knon))                 y_flux_v(:knon))
347    
348            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
349            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
350                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos(:knon), &
351                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &                 yrugoro(:knon), yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), &
352                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 ycdragh(:knon), yt(:knon, :), yq(:knon, :), yts(:knon), &
353                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 ypaprs(:knon, :), ypplay(:knon, :), ydelp(:knon, :), &
354                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf(:knon), yrain_f, &
355                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
356                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
357                   yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
358                   y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
359                   y_ffonte, y_run_off_lic_0)
360    
361            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
362    
363            yrugm = 0.            yrugm = 0.
364    
365            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
366               DO j = 1, knon               DO j = 1, knon
367                  yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &
368                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
369                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
370                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
371               END DO               END DO
372            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  
373    
374            DO k = 1, klev            DO k = 1, klev
375               DO j = 1, knon               DO j = 1, knon
376                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
377                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
378                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
379                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
# Line 464  contains Line 407  contains
407               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
408               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
409               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
410               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
411               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
412               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
413               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
414            END DO            END DO
415            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
416               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 488  contains Line 431  contains
431                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)
432                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)
433                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)
                 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)  
434               END DO               END DO
435            END DO            END DO
436    
437              forall (k = 2:klev) coefh(ni(:knon), k) &
438                   = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)
439    
440            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
441    
442            DO j = 1, knon            DO j = 1, knon
# Line 513  contains Line 458  contains
458               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
459            END DO            END DO
460    
461            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
462                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
463                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)                 yq10m, wind10m(:knon), ustar(:knon))
464    
465            DO j = 1, knon            DO j = 1, knon
466               i = ni(j)               i = ni(j)
# Line 529  contains Line 474  contains
474            END DO            END DO
475    
476            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
477                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt(:knon, :), yq, ypblh(:knon), &
478                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycapcl, yoliqcl, ycteicl, ypblt, ytherm, ylcl)
479    
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
# Line 541  contains Line 486  contains
486               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
487               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
488               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)  
489            END DO            END DO
490    
491            DO j = 1, knon            DO j = 1, knon
# Line 564  contains Line 506  contains
506    
507      firstcal = .false.      firstcal = .false.
508    
509    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
510    
511  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.227  
changed lines
  Added in v.293
  ViewVC Help
Powered by ViewVC 1.1.21