/[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 227 by guez, Thu Nov 2 15:47:03 2017 UTC revision 243 by guez, Tue Nov 14 14:38:36 2017 UTC
# Line 25  contains Line 25  contains
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
27      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
28        use coefkz2_m, only: coefkz2
29      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
31      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
# Line 36  contains Line 37  contains
37      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
38      use time_phylmdz, only: itap      use time_phylmdz, only: itap
39      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
     use vdif_kcay_m, only: vdif_kcay  
40      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
41    
42      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
# Line 96  contains Line 96  contains
96      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
97    
98      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99      ! tension du vent à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
100    
101      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
102      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
# Line 106  contains Line 106  contains
106      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
107      ! IM "slab" ocean      ! IM "slab" ocean
108    
109      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(:, 2:) ! (klon, 2:klev)
110      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
111      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
112      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! ce champ sur les quatre sous-surfaces du mod\`ele.
# Line 164  contains Line 164  contains
164      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
165      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
166      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
167      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, 2:klev), coefm(klon, 2:klev)
168        real ycdragh(klon), ycdragm(klon)
169      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
170      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
171      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
172        REAL ycoefm0(klon, 2:klev), ycoefh0(klon, 2:klev)
     REAL ycoefm0(klon, klev), ycoefh0(klon, klev)  
   
173      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
174      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
     REAL ykmq(klon, klev + 1)  
175      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
176      REAL delp(klon, klev)      REAL delp(klon, klev)
177      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
178      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
179    
180      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
# Line 315  contains Line 310  contains
310               END DO               END DO
311            END DO            END DO
312    
           ! calculer Cdrag et les coefficients d'echange  
313            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
314                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
315                 coefh(:knon, :))                 coefh(:knon, :), ycdragm(:knon), ycdragh(:knon))
316              
317            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
318               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, :), &
319                      ycoefh0(:knon, :))
320               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
321               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
322                 ycdragm(:knon) = max(ycdragm(:knon), 0.)
323                 ycdragh(:knon) = max(ycdragh(:knon), 0.)
324            END IF            END IF
325    
326            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
327            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
328               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
329               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
330            END IF            END IF
331    
332            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
333               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
334               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
335                    coefm(:knon, 1), ycoefm0, ycoefh0)                    ycdragm(:knon), ycoefh0(:knon, :))
336                 ycoefm0(:knon, :) = ycoefh0(:knon, :)
337               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
338               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
339            END IF            END IF
340    
341            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
342               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
343               ! Fr\'ed\'eric Hourdin               ! Fr\'ed\'eric Hourdin
344               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
345                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
346                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
347                
348               DO k = 2, klev               DO k = 2, klev
349                  yzlay(:knon, k) = yzlay(:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
350                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
# Line 374  contains Line 372  contains
372                  END DO                  END DO
373               END DO               END DO
374    
375               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))
376                 CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
377               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &
378                      ykmm(:knon, :), ykmn(:knon, :), ustar(:knon))
379               IF (iflag_pbl >= 11) THEN               coefm(:knon, :) = ykmm(:knon, 2:klev)
380                  CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &               coefh(:knon, :) = ykmn(:knon, 2:klev)
                      coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &  
                      iflag_pbl)  
              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)  
381            END IF            END IF
382    
383            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
384            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
385                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
386                 y_flux_u(:knon))                 y_flux_u(:knon))
387            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
388                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
389                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
390                 y_flux_v(:knon))                 y_flux_v(:knon))
391    
392            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
393            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
394                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
395                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), ycdragh(:knon), &
396                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
397                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
398                 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, &
399                 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), &
400                 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, &
401                   y_run_off_lic_0)
402    
403            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
404            yrugm = 0.            yrugm = 0.
405            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
406               DO j = 1, knon               DO j = 1, knon
407                  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) &
408                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
409                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
410                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
411               END DO               END DO
412            END IF            END IF
# Line 429  contains Line 418  contains
418            DO k = 1, klev            DO k = 1, klev
419               DO j = 1, knon               DO j = 1, knon
420                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
421                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
422                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
423                  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 451  contains
451               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
452               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
453               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
454               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
455               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
456               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
457               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
458            END DO            END DO
# Line 488  contains Line 475  contains
475                  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)
476                  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)
477                  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)  
478               END DO               END DO
479            END DO            END DO
480    
481              forall (k = 2:klev) ycoefh(ni(:knon), k) &
482                   = ycoefh(ni(:knon), k) + coefh(:knon, k) * ypct(:knon)
483    
484            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
485    
486            DO j = 1, knon            DO j = 1, knon
Legend:
Removed from v.227  
changed lines
  Added in v.243
  ViewVC Help
Powered by ViewVC 1.1.21