/[lmdze]/trunk/Sources/phylmd/clmain.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/clmain.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC revision 250 by guez, Fri Jan 5 18:18:53 2018 UTC
# Line 5  module clmain_m Line 5  module clmain_m
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &    SUBROUTINE clmain(dtime, 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, zu1, zv1, t2m, &         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, trmb1, trmb2, trmb3, plcl, fqcalving, &
13         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         ffonte, run_off_lic_0)
14    
15      ! 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
16      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
# 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      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent      use clcdrag_m, only: clcdrag
     ! 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.  
   
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, zmasq
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# Line 38  contains Line 33  contains
33      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
34      USE interfoce_lim_m, ONLY: interfoce_lim      USE interfoce_lim_m, ONLY: interfoce_lim
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 152  contains Line 145  contains
145      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
146      REAL rugmer(klon)      REAL rugmer(klon)
147      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
148      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
149        real yrugos(klon) ! longeur de rugosite (en m)
150      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
151      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
152      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
153      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 160  contains
160      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
161      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
162      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
163      REAL coefh(klon, klev), coefm(klon, klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
164        real ycdragh(klon), ycdragm(klon)
165      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
166      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
167      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)  
168      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
169      REAL delp(klon, klev)      REAL delp(klon, klev)
170      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
171      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
172    
173      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
174      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
175      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
176    
177      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
178      REAL yustar(klon)      REAL ustar(klon)
179    
180      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
181      REAL ypblh(klon)      REAL ypblh(klon)
# Line 206  contains Line 188  contains
188      REAL ytrmb1(klon)      REAL ytrmb1(klon)
189      REAL ytrmb2(klon)      REAL ytrmb2(klon)
190      REAL ytrmb3(klon)      REAL ytrmb3(klon)
191      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
192      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
193      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
194    
195      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
196      REAL rugo1(klon)      REAL rugo1(klon)
197        REAL zgeop(klon, klev)
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
198    
199      !------------------------------------------------------------      !------------------------------------------------------------
200    
# Line 233  contains Line 212  contains
212      cdragm = 0.      cdragm = 0.
213      dflux_t = 0.      dflux_t = 0.
214      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
215      ypct = 0.      ypct = 0.
216      yqsurf = 0.      yqsurf = 0.
217      yrain_f = 0.      yrain_f = 0.
# Line 260  contains Line 237  contains
237      d_q = 0.      d_q = 0.
238      d_u = 0.      d_u = 0.
239      d_v = 0.      d_v = 0.
240      ycoefh = 0.      coefh = 0.
241    
242      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
243      ! 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 281  contains
281               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
282               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
283               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
284               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
285               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
286               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 304  contains
304               END DO               END DO
305            END DO            END DO
306    
307            ! calculer Cdrag et les coefficients d'echange            ! Calculer les géopotentiels de chaque couche:
308            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &  
309                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
310                 coefh(:knon, :))                 + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
311    
312              DO k = 2, klev
313                 zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
314                      * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
315                      * (ypplay(:knon, k - 1) - ypplay(:knon, k))
316              ENDDO
317    
318              CALL clcdrag(nsrf, yu(:knon, 1), yv(:knon, 1), yt(:knon, 1), &
319                   yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &
320                   yrugos(:knon), ycdragm(:knon), ycdragh(:knon))
321    
322            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
323               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
324               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               ycdragh(:knon) = max(ycdragh(:knon), 0.)
325               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))            end IF
           END IF  
326    
327            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
328            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
329               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
330               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
331            END IF            END IF
332    
333            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  
334               DO k = 1, klev + 1               DO k = 1, klev + 1
335                  DO j = 1, knon                  DO j = 1, knon
336                     i = ni(j)                     i = ni(j)
337                     yq2(j, k) = q2(i, k, nsrf)                     yq2(j, k) = q2(i, k, nsrf)
338                  END DO                  END DO
339               END DO               END DO
340              end IF
341    
342               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs, ypplay, yu, yv, &
343               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar                 yq, yt, yts, ycdragm, zgeop(:knon, :), ycoefm(:knon, :), &
344                   ycoefh(:knon, :), yq2)
345               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange  
346              CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
347               IF (iflag_pbl >= 11) THEN                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
348                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
                      yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &  
                      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, &  
349                 y_flux_u(:knon))                 y_flux_u(:knon))
350            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
351                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
352                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
353                 y_flux_v(:knon))                 y_flux_v(:knon))
354    
355            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
356            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
357                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
358                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
359                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
360                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
361                 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, &
362                 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), &
363                 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, &
364                   y_run_off_lic_0)
365    
366            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
367            yrugm = 0.            yrugm = 0.
368            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
369               DO j = 1, knon               DO j = 1, knon
370                  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) &
371                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
372                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
373                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
374               END DO               END DO
375            END IF            END IF
# Line 436  contains Line 381  contains
381            DO k = 1, klev            DO k = 1, klev
382               DO j = 1, knon               DO j = 1, knon
383                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
384                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
385                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
386                  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 414  contains
414               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
415               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
416               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
417               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
418               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
419               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
420               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)  
421            END DO            END DO
422            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
423               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 497  contains Line 438  contains
438                  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)
439                  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)
440                  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)  
441               END DO               END DO
442            END DO            END DO
443    
444              forall (k = 2:klev) coefh(ni(:knon), k) &
445                   = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)
446    
447            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
448    
449            DO j = 1, knon            DO j = 1, knon
450               i = ni(j)               i = ni(j)
451               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
452               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
453               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
454               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
455               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 465  contains
465               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
466            END DO            END DO
467    
468            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
469                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
470                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))
471    
472            DO j = 1, knon            DO j = 1, knon
473               i = ni(j)               i = ni(j)
474               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
475               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
476    
477               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
478                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
479               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
480                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
481            END DO            END DO
482    
483            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
484                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
485                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
486    
Legend:
Removed from v.225  
changed lines
  Added in v.250
  ViewVC Help
Powered by ViewVC 1.1.21