/[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 225 by guez, Mon Oct 16 12:35:41 2017 UTC trunk/phylmd/pbl_surface.f revision 276 by guez, Thu Jul 12 14:49:20 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, zu1, zv1, t2m, &         q2, dflux_t, dflux_q, coefh, t2m, q2m, u10m_srf, v10m_srf, pblh, capcl, &
12         q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, &         oliqcl, cteicl, pblt, therm, plcl, fqcalving, ffonte, run_off_lic_0)
        trmb1, 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/08/18
# 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      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent      use cdrag_m, only: cdrag
     ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",  
     ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois  
     ! champs sur les quatre sous-surfaces du mod\`ele.  
   
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
27      use coefkzmin_m, only: coefkzmin      USE conf_gcm_m, ONLY: lmt_pas
     USE conf_gcm_m, ONLY: prt_level, 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 56  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 101  contains Line 91  contains
91      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
92    
93      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
94      ! tension du vent à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
95    
96      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
97      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
# Line 111  contains Line 101  contains
101      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
102      ! IM "slab" ocean      ! IM "slab" ocean
103    
104      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
105      REAL, intent(out):: zu1(klon), zv1(klon)      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
106        ! "coefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
107        ! ce champ sur les quatre sous-surfaces du mod\`ele.
108    
109      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
110    
111      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
# Line 127  contains Line 120  contains
120      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
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)
     REAL trmb1(klon, nbsrf)  
     ! trmb1-------deep_cape  
     REAL trmb2(klon, nbsrf)  
     ! trmb2--------inhibition  
     REAL trmb3(klon, nbsrf)  
     ! trmb3-------Point Omega  
123      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
124      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
125      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
# Line 152  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) ! longeur de rugosite (en m)
144      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
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
147      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
# Line 170  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), yzlev(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)
168      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
169      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
170    
171      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
172      REAL yustar(klon)      REAL ustar(klon)
173    
174      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
175      REAL ypblh(klon)      REAL ypblh(klon)
# Line 203  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)
182      REAL ytrmb1(klon)      REAL u1(klon), v1(klon)
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
     REAL uzon(klon), vmer(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)
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
189    
190      !------------------------------------------------------------      !------------------------------------------------------------
191    
# Line 233  contains Line 203  contains
203      cdragm = 0.      cdragm = 0.
204      dflux_t = 0.      dflux_t = 0.
205      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
206      ypct = 0.      ypct = 0.
207      yqsurf = 0.      yqsurf = 0.
208      yrain_f = 0.      yrain_f = 0.
# Line 260  contains Line 228  contains
228      d_q = 0.      d_q = 0.
229      d_u = 0.      d_u = 0.
230      d_v = 0.      d_v = 0.
231      ycoefh = 0.      coefh = 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 304  contains Line 272  contains
272               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
273               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
274               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
275               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
276               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
277               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
# Line 329  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:
299            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &  
300                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
301                 coefh(:knon, :))                 + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
302    
303              DO k = 2, klev
304                 zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
305                      * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
306                      * (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            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
315               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
316               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               ycdragh(:knon) = max(ycdragh(:knon), 0.)
317               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))            end IF
           END IF  
318    
319            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
320            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
321               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
322               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
323            END IF            END IF
324    
325            IF (ok_kzmin) THEN            IF (iflag_pbl >= 6) 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  
   
           IF (iflag_pbl >= 3) 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(1:knon, k) = yzlay(1: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  
              yzlev(1:knon, 1) = 0.  
              yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &  
                   - yzlay(:knon, klev - 1)  
              DO k = 2, klev  
                 yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))  
              END DO  
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               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs(:knon, :), &
335               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
336                   yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
337               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                 ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
338    
339               IF (iflag_pbl >= 11) THEN            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
340                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
341                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
                      iflag_pbl)  
              ELSE  
                 CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &  
                      coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, 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, u1lay(:knon), v1lay(:knon), &  
                coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &  
342                 y_flux_u(:knon))                 y_flux_u(:knon))
343            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            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, yrugoro, &
351                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
352                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
353                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
354                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &
355                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &
356                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &
357                   y_run_off_lic_0)
358    
359            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
360            yrugm = 0.            yrugm = 0.
361            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
362               DO j = 1, knon               DO j = 1, knon
363                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &
364                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
365                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
366                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
367               END DO               END DO
368            END IF            END IF
# Line 436  contains Line 374  contains
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 471  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)
413               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
              zu1(i) = zu1(i) + u1lay(j) * ypct(j)  
              zv1(i) = zv1(i) + v1lay(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 497  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
443               i = ni(j)               i = ni(j)
444               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
445               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
446               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
447               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
448               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
# Line 522  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, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
462                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
463                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq10m, wind10m(:knon), ustar(:knon))
464    
465            DO j = 1, knon            DO j = 1, knon
466               i = ni(j)               i = ni(j)
467               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
468               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
469    
470               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
471                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
472               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
473                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
474            END DO            END DO
475    
476            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, 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, yq, ypblh(:knon), ycapcl, &
478                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ylcl)
479    
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
# Line 550  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 573  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.225  
changed lines
  Added in v.276
  ViewVC Help
Powered by ViewVC 1.1.21