/[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 226 by guez, Mon Oct 16 13:04:05 2017 UTC trunk/phylmd/Interface_surf/pbl_surface.f revision 303 by guez, Thu Sep 6 14:25:07 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)
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
28      use coefkzmin_m, only: coefkzmin      USE conf_gcm_m, ONLY: lmt_pas
     USE conf_gcm_m, ONLY: prt_level, 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 vdif_kcay_m, only: vdif_kcay  
     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 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(:, :), 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 89  contains Line 83  contains
83      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
84    
85      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
86      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers      ! flux de chaleur sensible (c_p T) (W / m2) (orientation positive
87      ! le bas) à la surface      ! vers le bas) à la surface
88    
89      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
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)
97    
98      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      ! Ocean slab:
99      ! dflux_t derive du flux sensible      REAL, INTENT(out):: dflux_t(klon) ! derive du flux sensible
100      ! dflux_q derive du flux latent      REAL, INTENT(out):: dflux_q(klon) ! derive du flux latent
     ! IM "slab" ocean  
101    
102      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
103      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
104      ! "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
105      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! ce champ sur les quatre sous-surfaces du mod\`ele.
106    
107      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
# Line 125  contains Line 118  contains
118      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
119      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
120      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  
121      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)  
122    
123      ! Local:      REAL, intent(out):: fqcalving(klon, nbsrf)
124        ! flux d'eau "perdue" par la surface et necessaire pour limiter la
125        ! hauteur de neige, en kg / m2 / s
126    
127      LOGICAL:: firstcal = .true.      real ffonte(klon, nbsrf) ! flux thermique utilise pour fondre la neige
128        REAL, intent(inout):: run_off_lic_0(:) ! (klon)
129    
130        ! Local:
131    
132      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
133      REAL, save:: pctsrf_new_oce(klon)      REAL, save:: pctsrf_new_oce(klon)
134      REAL, save:: pctsrf_new_sic(klon)      REAL, save:: pctsrf_new_sic(klon)
135    
136      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
137      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon), y_run_off_lic(klon)
138        REAL run_off_lic(klon) ! ruissellement total
139      REAL rugmer(klon)      REAL rugmer(klon)
140      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
141      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
142        real yrugos(klon) ! longueur de rugosite (en m)
143      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
144      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
145      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
146      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 168  contains Line 153  contains
153      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
154      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
155      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
156      REAL coefh(klon, klev), coefm(klon, klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
157        real ycdragh(klon), ycdragm(klon)
158      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
159      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
160      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)  
161      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
162      REAL delp(klon, klev)      REAL delp(klon, klev)
163      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
164      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
165    
166      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
167      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
168      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
169    
170      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
171      REAL yustar(klon)      REAL ustar(klon)
172    
173      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
174      REAL ypblh(klon)      REAL ypblh(klon)
# Line 201  contains Line 178  contains
178      REAL ycteicl(klon)      REAL ycteicl(klon)
179      REAL ypblt(klon)      REAL ypblt(klon)
180      REAL ytherm(klon)      REAL ytherm(klon)
181      REAL ytrmb1(klon)      REAL u1(klon), v1(klon)
     REAL ytrmb2(klon)  
     REAL ytrmb3(klon)  
     REAL uzon(klon), vmer(klon)  
182      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
183      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
184    
185      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
186      REAL rugo1(klon)      REAL rugo1(klon)
187        REAL zgeop(klon, klev)
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
188    
189      !------------------------------------------------------------      !------------------------------------------------------------
190    
# Line 239  contains Line 210  contains
210      ypaprs = 0.      ypaprs = 0.
211      ypplay = 0.      ypplay = 0.
212      ydelp = 0.      ydelp = 0.
     yu = 0.  
     yv = 0.  
     yt = 0.  
     yq = 0.  
     y_dflux_t = 0.  
     y_dflux_q = 0.  
213      yrugoro = 0.      yrugoro = 0.
214      d_ts = 0.      d_ts = 0.
215      flux_t = 0.      flux_t = 0.
# Line 256  contains Line 221  contains
221      d_q = 0.      d_q = 0.
222      d_u = 0.      d_u = 0.
223      d_v = 0.      d_v = 0.
224      ycoefh = 0.      coefh = 0.
225        fqcalving = 0.
226        run_off_lic = 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
230      ! (\`a affiner)      ! (\`a affiner).
231    
232      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
233      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
# Line 275  contains Line 242  contains
242      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
243    
244      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
245         ! Chercher les indices :         ! Define ni and knon:
246          
247         ni = 0         ni = 0
248         knon = 0         knon = 0
249    
250         DO i = 1, klon         DO i = 1, klon
251            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
252            ! "potentielles"            ! "potentielles"
# Line 300  contains Line 269  contains
269               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
270               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
271               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
272               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
273               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
274               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
# Line 325  contains Line 292  contains
292               END DO               END DO
293            END DO            END DO
294    
295            ! 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  
   
           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  
              DO k = 1, klev + 1  
                 DO j = 1, knon  
                    i = ni(j)  
                    yq2(j, k) = q2(i, k, nsrf)  
                 END DO  
              END DO  
296    
297               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
298               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar                 + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
299    
300               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange            DO k = 2, klev
301                 zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
302                      * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
303                      * (ypplay(:knon, k - 1) - ypplay(:knon, k))
304              ENDDO
305    
306              CALL cdrag(nsrf, sqrt(yu(:knon, 1)**2 + yv(:knon, 1)**2), &
307                   yt(:knon, 1), yq(:knon, 1), zgeop(:knon, 1), ypaprs(:knon, 1), &
308                   yts(:knon), yqsurf(:knon), yrugos(:knon), ycdragm(:knon), &
309                   ycdragh(:knon))
310    
311               IF (iflag_pbl >= 11) THEN            IF (iflag_pbl == 1) THEN
312                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &               ycdragm(:knon) = max(ycdragm(:knon), 0.)
313                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &               ycdragh(:knon) = max(ycdragh(:knon), 0.)
314                       iflag_pbl)            end IF
              ELSE  
                 CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &  
                      coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)  
              END IF  
315    
316               coefm(:knon, 2:) = ykmm(:knon, 2:klev)            ! on met un seuil pour ycdragm et ycdragh
317               coefh(:knon, 2:) = ykmn(:knon, 2:klev)            IF (nsrf == is_oce) THEN
318                 ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
319                 ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
320            END IF            END IF
321    
322            ! calculer la diffusion des vitesses "u" et "v"            IF (iflag_pbl >= 6) yq2(:knon, :) = q2(ni(:knon), :, nsrf)
323            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            call coef_diff_turb(nsrf, ni(:knon), ypaprs(:knon, :), &
324                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 ypplay(:knon, :), yu(:knon, :), yv(:knon, :), yq(:knon, :), &
325                   yt(:knon, :), yts(:knon), ycdragm(:knon), zgeop(:knon, :), &
326                   ycoefm(:knon, :), ycoefh(:knon, :), yq2(:knon, :))
327              
328              CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
329                   ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
330                   ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
331                 y_flux_u(:knon))                 y_flux_u(:knon))
332            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
333                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
334                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
335                 y_flux_v(:knon))                 y_flux_v(:knon))
336    
337            ! calculer la diffusion de "q" et de "h"            CALL clqh(julien, nsrf, ni(:knon), ytsoil(:knon, :), yqsol(:knon), &
338            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &                 mu0(ni(:knon)), yrugos(:knon), yrugoro(:knon), yu(:knon, 1), &
339                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), yt(:knon, :), &
340                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yq(:knon, :), yts(:knon), ypaprs(:knon, :), ypplay(:knon, :), &
341                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 ydelp(:knon, :), yrads(:knon), yalb(:knon), snow(:knon), &
342                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yqsurf(:knon), yrain_f(:knon), ysnow_f(:knon), yfluxlat(:knon), &
343                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 pctsrf_new_sic(ni(:knon)), yagesno(:knon), y_d_t(:knon, :), &
344                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 y_d_q(:knon, :), y_d_ts(:knon), yz0_new(:knon), &
345                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
346                   y_dflux_q(:knon), y_fqcalving(:knon), y_ffonte(:knon), &
347                   y_run_off_lic_0(:knon), y_run_off_lic(:knon))
348    
349            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
350    
351            yrugm = 0.            yrugm = 0.
352    
353            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
354               DO j = 1, knon               DO j = 1, knon
355                  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) &
356                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
357                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
358                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
359               END DO               END DO
360            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  
361    
362            DO k = 1, klev            DO k = 1, klev
363               DO j = 1, knon               DO j = 1, knon
364                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
365                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
366                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
367                  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 467  contains Line 395  contains
395               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
396               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
397               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
398               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
399               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
400               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j) * ypct(j)
401               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j) * ypct(j)
402            END DO            END DO
403            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
404               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 478  contains Line 406  contains
406               DO j = 1, knon               DO j = 1, knon
407                  i = ni(j)                  i = ni(j)
408                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
409                    run_off_lic(i) = y_run_off_lic(j)
410               END DO               END DO
411            END IF            END IF
412    
# Line 491  contains Line 420  contains
420                  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)
421                  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)
422                  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)  
423               END DO               END DO
424            END DO            END DO
425    
426              forall (k = 2:klev) coefh(ni(:knon), k) &
427                   = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)
428    
429            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
430    
431            DO j = 1, knon            DO j = 1, knon
432               i = ni(j)               i = ni(j)
433               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
434               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
435               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
436               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
437               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 516  contains Line 447  contains
447               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
448            END DO            END DO
449    
450            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(nsrf, u1(:knon), v1(:knon), tair1(:knon), qair1, &
451                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, &
452                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq10m, wind10m(:knon), ustar(:knon))
453    
454            DO j = 1, knon            DO j = 1, knon
455               i = ni(j)               i = ni(j)
456               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
457               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
458    
459               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
460                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
461               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
462                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
463            END DO            END DO
464    
465            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
466                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
467                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yq(:knon, :), ypblh(:knon), ycapcl, yoliqcl, ycteicl, ypblt, &
468                   ytherm, ylcl)
469    
470            DO j = 1, knon            DO j = 1, knon
471               i = ni(j)               i = ni(j)
# Line 544  contains Line 476  contains
476               cteicl(i, nsrf) = ycteicl(j)               cteicl(i, nsrf) = ycteicl(j)
477               pblt(i, nsrf) = ypblt(j)               pblt(i, nsrf) = ypblt(j)
478               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)  
479            END DO            END DO
480    
481            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  
482         else         else
483            fsnow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
484         end IF if_knon         end IF if_knon
# Line 565  contains Line 489  contains
489      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
490      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
491    
492      firstcal = .false.      CALL histwrite_phy("run_off_lic", run_off_lic)
493    
494    END SUBROUTINE clmain    END SUBROUTINE pbl_surface
495    
496  end module clmain_m  end module pbl_surface_m

Legend:
Removed from v.226  
changed lines
  Added in v.303

  ViewVC Help
Powered by ViewVC 1.1.21