/[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 228 by guez, Fri Nov 3 12:38:47 2017 UTC revision 248 by guez, Fri Jan 5 16:40:13 2018 UTC
# Line 8  contains Line 8  contains
8         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, coefh, t2m, q2m, &
12         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
14    
# 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 clcdrag_m, only: clcdrag
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 coefkz_m, only: coefkz
28      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
29        use coefkz2_m, only: coefkz2
30      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
31      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
32      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
# Line 95  contains Line 97  contains
97      ! flux de vapeur d'eau (kg / m2 / s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
98    
99      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
100      ! tension du vent à la surface, en Pa      ! tension du vent (flux turbulent de vent) à la surface, en Pa
101    
102      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
103      real q2(klon, klev + 1, nbsrf)      real q2(klon, klev + 1, nbsrf)
# Line 105  contains Line 107  contains
107      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
108      ! IM "slab" ocean      ! IM "slab" ocean
109    
110      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: coefh(:, 2:) ! (klon, 2:klev)
111      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
112      ! "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
113      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! ce champ sur les quatre sous-surfaces du mod\`ele.
114    
115      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
# Line 149  contains Line 151  contains
151      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
152      REAL rugmer(klon)      REAL rugmer(klon)
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
154      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), ypct(klon), yz0_new(klon)
155        real yrugos(klon) ! longeur de rugosite (en m)
156      REAL yalb(klon)      REAL yalb(klon)
157      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
158      real yqsol(klon) ! column-density of water in soil, in kg m-2      real yqsol(klon) ! column-density of water in soil, in kg m-2
# Line 163  contains Line 166  contains
166      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
167      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
168      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
169      REAL coefh(klon, klev), coefm(klon, klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
170        real ycdragh(klon), ycdragm(klon)
171      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
172      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
173      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
174      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, 2:klev), ycoefh0(klon, 2:klev)
175      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
     REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)  
     REAL ykmq(klon, klev + 1)  
176      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
177      REAL delp(klon, klev)      REAL delp(klon, klev)
178      INTEGER i, k, nsrf      INTEGER i, k, nsrf
# Line 200  contains Line 202  contains
202    
203      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
204      REAL rugo1(klon)      REAL rugo1(klon)
205        REAL zgeop(klon, klev)
206    
207      !------------------------------------------------------------      !------------------------------------------------------------
208    
# Line 242  contains Line 245  contains
245      d_q = 0.      d_q = 0.
246      d_u = 0.      d_u = 0.
247      d_v = 0.      d_v = 0.
248      ycoefh = 0.      coefh = 0.
249    
250      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
251      ! 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 309  contains Line 312  contains
312               END DO               END DO
313            END DO            END DO
314    
315            ! calculer Cdrag et les coefficients d'echange            ! Calculer les géopotentiels de chaque couche:
316            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &  
317                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &            zgeop(:knon, 1) = RD * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
318                 coefh(:knon, :))                 + ypplay(:knon, 1))) * (ypaprs(:knon, 1) - ypplay(:knon, 1))
319    
320              DO k = 2, klev
321                 zgeop(:knon, k) = zgeop(:knon, k - 1) + RD * 0.5 &
322                      * (yt(:knon, k - 1) + yt(:knon, k)) / ypaprs(:knon, k) &
323                      * (ypplay(:knon, k - 1) - ypplay(:knon, k))
324              ENDDO
325    
326              CALL clcdrag(nsrf, yu(:knon, 1), yv(:knon, 1), yt(:knon, 1), &
327                   yq(:knon, 1), zgeop(:knon, 1), yts(:knon), yqsurf(:knon), &
328                   yrugos(:knon), ycdragm(:knon), ycdragh(:knon))
329    
330              CALL coefkz(nsrf, ypaprs(:knon, :), ypplay(:knon, :), ksta, &
331                   ksta_ter, yts(:knon), yu(:knon, :), yv(:knon, :), yt(:knon, :), &
332                   yq(:knon, :), zgeop(:knon, :), ycoefm(:knon, :), &
333                   ycoefh(:knon, :))
334    
335            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
336               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, :), &
337               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))                    ycoefh0(:knon, :))
338               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))
339                 ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))
340                 ycdragm(:knon) = max(ycdragm(:knon), 0.)
341                 ycdragh(:knon) = max(ycdragh(:knon), 0.)
342            END IF            END IF
343    
344            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
345            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
346               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
347               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
348            END IF            END IF
349    
350            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
351               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
352               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
353                    coefm(:knon, 1), ycoefm0, ycoefh0)                    ycdragm(:knon), ycoefh0(:knon, :))
354               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               ycoefm0(:knon, :) = ycoefh0(:knon, :)
355               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               ycoefm(:knon, :) = max(ycoefm(:knon, :), ycoefm0(:knon, :))
356                 ycoefh(:knon, :) = max(ycoefh(:knon, :), ycoefh0(:knon, :))
357            END IF            END IF
358    
359            IF (iflag_pbl >= 6) THEN            IF (iflag_pbl >= 6) THEN
# Line 368  contains Line 390  contains
390                  END DO                  END DO
391               END DO               END DO
392    
393               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))
   
              ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange  
   
394               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
395                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), &                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &
396                    coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &                    ycoefm(:knon, :), ycoefh(:knon, :), ustar(:knon))
                   ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), iflag_pbl)  
   
              coefm(:knon, 2:) = ykmm(:knon, 2:klev)  
              coefh(:knon, 2:) = ykmn(:knon, 2:klev)  
397            END IF            END IF
398    
399            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
400            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
401                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
402                 y_flux_u(:knon))                 y_flux_u(:knon))
403            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
404                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
405                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
406                 y_flux_v(:knon))                 y_flux_v(:knon))
407    
408            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
409            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
410                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
411                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
412                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
413                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
414                 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, &
415                 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), &
416                 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, &
417                   y_run_off_lic_0)
418    
419            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
420            yrugm = 0.            yrugm = 0.
421            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
422               DO j = 1, knon               DO j = 1, knon
423                  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) &
424                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
425                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))                       / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
426                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
427               END DO               END DO
428            END IF            END IF
# Line 417  contains Line 434  contains
434            DO k = 1, klev            DO k = 1, klev
435               DO j = 1, knon               DO j = 1, knon
436                  i = ni(j)                  i = ni(j)
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
437                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
438                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
439                  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 452  contains Line 467  contains
467               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
468               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
469               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
470               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
471               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j) * ypct(j)
472               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
473               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
474            END DO            END DO
# Line 476  contains Line 491  contains
491                  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)
492                  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)
493                  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)  
494               END DO               END DO
495            END DO            END DO
496    
497              forall (k = 2:klev) coefh(ni(:knon), k) &
498                   = coefh(ni(:knon), k) + ycoefh(:knon, k) * ypct(:knon)
499    
500            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
501    
502            DO j = 1, knon            DO j = 1, knon
# Line 503  contains Line 520  contains
520    
521            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
522                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
523                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))
524    
525            DO j = 1, knon            DO j = 1, knon
526               i = ni(j)               i = ni(j)

Legend:
Removed from v.228  
changed lines
  Added in v.248

  ViewVC Help
Powered by ViewVC 1.1.21