/[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/Sources/phylmd/clmain.f revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 300 by guez, Thu Aug 2 15:55:01 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, evap, falbe, fluxlat, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         rain_fall, snow_f, 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, ycoefh, 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), 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  
   
     REAL, INTENT(IN):: dtime ! interval du temps (secondes)  
38    
39      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
40      ! tableau des pourcentages de surface de chaque maille      ! tableau des pourcentages de surface de chaque maille
# Line 51  contains Line 46  contains
46      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
47      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
48      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  
49    
50      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
51      ! soil temperature of surface fraction      ! soil temperature of surface fraction
# Line 79  contains Line 72  contains
72      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
73      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
74    
75      REAL d_t(klon, klev), d_q(klon, klev)      REAL, intent(out):: d_t(:, :), d_q(:, :) ! (klon, klev)
76      ! d_t------output-R- le changement pour "t"      ! changement pour t et q
     ! d_q------output-R- le changement pour "q"  
77    
78      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
79      ! changement pour "u" et "v"      ! changement pour "u" et "v"
# Line 96  contains Line 88  contains
88      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
89    
90      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
91      ! tension du vent à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
92    
93      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
94      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
# Line 106  contains Line 98  contains
98      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
99      ! IM "slab" ocean      ! IM "slab" ocean
100    
101      REAL, intent(out):: ycoefh(klon, 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
103      ! "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
104      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! ce champ sur les quatre sous-surfaces du mod\`ele.
105    
106      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
# 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)
121      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
122        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        real ffonte(klon, nbsrf)
127      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
128      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      REAL, intent(inout):: run_off_lic_0(:) ! (klon)
     !           hauteur de neige, en kg / m2 / s  
     REAL run_off_lic_0(klon)  
129    
130      ! Local:      ! Local:
131    
# Line 150  contains Line 139  contains
139      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
140      REAL rugmer(klon)      REAL rugmer(klon)
141      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
142      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
143        real yrugos(klon) ! longueur de rugosite (en m)
144      REAL yalb(klon)      REAL yalb(klon)
145      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
146      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 154  contains
154      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
155      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
156      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
157      REAL coefh(klon, klev), coefm(klon, klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
158        real ycdragh(klon), ycdragm(klon)
159      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
160      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
161      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)  
162      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
163      REAL delp(klon, klev)      REAL delp(klon, klev)
164      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
165      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
166    
167      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
# Line 197  contains Line 179  contains
179      REAL ycteicl(klon)      REAL ycteicl(klon)
180      REAL ypblt(klon)      REAL ypblt(klon)
181      REAL ytherm(klon)      REAL ytherm(klon)
     REAL ytrmb1(klon)  
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
182      REAL u1(klon), v1(klon)      REAL u1(klon), v1(klon)
183      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
184      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
185    
186      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
187      REAL rugo1(klon)      REAL rugo1(klon)
188        REAL zgeop(klon, klev)
189    
190      !------------------------------------------------------------      !------------------------------------------------------------
191    
# Line 231  contains Line 211  contains
211      ypaprs = 0.      ypaprs = 0.
212      ypplay = 0.      ypplay = 0.
213      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
214      yrugoro = 0.      yrugoro = 0.
215      d_ts = 0.      d_ts = 0.
216      flux_t = 0.      flux_t = 0.
# Line 248  contains Line 222  contains
222      d_q = 0.      d_q = 0.
223      d_u = 0.      d_u = 0.
224      d_v = 0.      d_v = 0.
225      ycoefh = 0.      coefh = 0.
226        fqcalving = 0.
227    
228      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
229      ! 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 290  contains
290               END DO               END DO
291            END DO            END DO
292    
293            ! 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  
294    
295            IF (iflag_pbl >= 3) THEN            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
296               ! 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  
297    
298               DO k = 1, klev            DO k = 2, klev
299                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &               zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
300                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))                    * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
301               END DO                    * (ypplay(:knon, k - 1) - ypplay(:knon, k))
302              ENDDO
303    
304              CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
305                   yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
306                   yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
307                   ycdragh(:knon))
308    
309               zlev(:knon, 1) = 0.            IF (iflag_pbl == 1) THEN
310               zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &               ycdragm(:knon) = max(ycdragm(:knon), 0.)
311                    - yzlay(:knon, klev - 1)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
312              end IF
313    
314               DO k = 2, klev            ! on met un seuil pour ycdragm et ycdragh
315                  zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))            IF (nsrf == is_oce) THEN
316               END DO               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
317                 ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
318              END IF
319    
320              IF (iflag_pbl >= 6) then
321               DO k = 1, klev + 1               DO k = 1, klev + 1
322                  DO j = 1, knon                  DO j = 1, knon
323                     i = ni(j)                     i = ni(j)
324                     yq2(j, k) = q2(i, k, nsrf)                     yq2(j, k) = q2(i, k, nsrf)
325                  END DO                  END DO
326               END DO               END DO
327              end IF
328    
329               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))            call coef_diff_turb(nsrf, ni(:knon), ypaprs(:knon, :), &
330                   ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
331               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                 yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
332                   ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
333               IF (iflag_pbl >= 11) THEN  
334                  CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
335                       coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
336                       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, &  
337                 y_flux_u(:knon))                 y_flux_u(:knon))
338            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
339                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
340                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
341                 y_flux_v(:knon))                 y_flux_v(:knon))
342    
343            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &
344            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 yqsol(:knon), mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), &
345                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
346                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &                 yt(:knon, :), yq(:knon, :), yts(:knon), ypaprs(:knon, :), &
347                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 ypplay(:knon, :), ydelp(:knon, :), yrads(:knon), yalb(:knon), &
348                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 snow(:knon), yqsurf(:knon), yrain_f(:knon), ysnow_f(:knon), &
349                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 yfluxlat(:knon), pctsrf_new_sic(ni(:knon)), yagesno(:knon), &
350                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 y_d_t(:knon, :), y_d_q(:knon, :), y_d_ts(:knon), &
351                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)                 yz0_new(:knon), y_flux_t(:knon), y_flux_q(:knon), &
352                   y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving(:knon), &
353                   y_ffonte(:knon), y_run_off_lic_0(:knon))
354    
355            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
356    
357            yrugm = 0.            yrugm = 0.
358    
359            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
360               DO j = 1, knon               DO j = 1, knon
361                  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) &
362                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
363                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
364                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
365               END DO               END DO
366            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  
367    
368            DO k = 1, klev            DO k = 1, klev
369               DO j = 1, knon               DO j = 1, knon
370                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
371                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
372                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
373                  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 401  contains
401               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
402               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
403               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
404               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
405               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
406               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
407               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
408            END DO            END DO
409            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
410               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 488  contains Line 425  contains
425                  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)
426                  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)
427                  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)  
428               END DO               END DO
429            END DO            END DO
430    
431              forall (k = 2:klev) coefh(ni(:knon), k) &
432                   = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)
433    
434            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
435    
436            DO j = 1, knon            DO j = 1, knon
# Line 513  contains Line 452  contains
452               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
453            END DO            END DO
454    
455            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
456                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
457                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)                 yq10m, wind10m(:knon), ustar(:knon))
458    
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
# Line 529  contains Line 468  contains
468            END DO            END DO
469    
470            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
471                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
472                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
473                   ytherm, ylcl)
474    
475            DO j = 1, knon            DO j = 1, knon
476               i = ni(j)               i = ni(j)
# Line 541  contains Line 481  contains
481               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
482               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
483               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)  
484            END DO            END DO
485    
486            DO j = 1, knon            DO j = 1, knon
# Line 564  contains Line 501  contains
501    
502      firstcal = .false.      firstcal = .false.
503    
504    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
505    
506  end module clmain_m  end module pbl_surface_m
Legend:
Removed from v.227  
changed lines
  Added in v.300
  ViewVC Help
Powered by ViewVC 1.1.21