/[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 241 by guez, Mon Nov 13 11:51:04 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, 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, trmb1, trmb2, trmb3, plcl, fqcalving, &
13         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        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 coef_diff_turb_m, only: coef_diff_turb
     use coefkzmin_m, only: coefkzmin  
     use coefkz2_m, only: coefkz2  
28      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: 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
# Line 34  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 yamada4_m, only: yamada4  
38    
39      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
40    
# 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 106  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      ! Pour pouvoir extraire les coefficients d'\'echange, le champ      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
106      ! "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
107      ! ce champ sur les quatre sous-surfaces du mod\`ele.      ! 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)
# Line 150  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)
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
# Line 164  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, 2:klev), coefm(klon, 2:klev)      REAL ycoefh(klon, 2:klev), ycoefm(klon, 2:klev)
164      real ycdragh(klon), ycdragm(klon)      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, 2:klev), ycoefh0(klon, 2:klev)  
     REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)  
     REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)  
168      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
169      REAL delp(klon, klev)      REAL delp(klon, klev)
170      INTEGER i, k, nsrf      INTEGER i, k, nsrf
# Line 201  contains Line 194  contains
194    
195      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
196      REAL rugo1(klon)      REAL rugo1(klon)
197        REAL zgeop(klon, klev)
198    
199      !------------------------------------------------------------      !------------------------------------------------------------
200    
# Line 243  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 310  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, :), ycdragm(:knon), ycdragh(: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
              CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, :), &  
                   ycoefh0(:knon, :))  
              coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))  
              coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))  
323               ycdragm(:knon) = max(ycdragm(:knon), 0.)               ycdragm(:knon) = max(ycdragm(:knon), 0.)
324               ycdragh(:knon) = max(ycdragh(:knon), 0.)               ycdragh(:knon) = max(ycdragh(:knon), 0.)
325            END IF            end IF
326    
327            ! on met un seuil pour ycdragm et ycdragh            ! on met un seuil pour ycdragm et ycdragh
328            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
# Line 330  contains Line 330  contains
330               ycdragh(:knon) = min(ycdragh(:knon), 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, &  
                   ycdragm(:knon), ycoefh0(:knon, :))  
              ycoefm0(:knon, :) = ycoefh0(:knon, :)  
              coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))  
              coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))  
           END IF  
   
           IF (iflag_pbl >= 6) 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(:knon, k) = yzlay(: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  
   
              zlev(:knon, 1) = 0.  
              zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &  
                   - yzlay(:knon, klev - 1)  
   
              DO k = 2, klev  
                 zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(: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               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))            call coef_diff_turb(dtime, nsrf, ni(:knon), ypaprs, ypplay, yu, yv, &
343               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &                 yq, yt, yts, ycdragm, zgeop(:knon, :), ycoefm(:knon, :), &
344                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &                 ycoefh(:knon, :), yq2)
                   ykmm(:knon, :), ykmn(:knon, :), ustar(:knon))  
              coefm(:knon, :) = ykmm(:knon, 2:klev)  
              coefh(:knon, :) = ykmn(:knon, 2:klev)  
           END IF  
345    
346            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
347                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
348                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
349                 y_flux_u(:knon))                 y_flux_u(:knon))
350            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), ycoefm(:knon, :), &
351                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &                 ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
352                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
353                 y_flux_v(:knon))                 y_flux_v(:knon))
# Line 393  contains Line 355  contains
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                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), ycdragh(:knon), &                 yu(:knon, 1), yv(:knon, 1), ycoefh(:knon, :), ycdragh(:knon), &
359                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
360                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
361                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &
# Line 416  contains Line 378  contains
378               y_dflux_q(j) = y_dflux_q(j) * ypct(j)               y_dflux_q(j) = y_dflux_q(j) * ypct(j)
379            END DO            END DO
380    
           DO k = 2, klev  
              DO j = 1, knon  
                 i = ni(j)  
                 coefh(j, k) = coefh(j, k) * ypct(j)  
                 coefm(j, k) = coefm(j, k) * ypct(j)  
              END DO  
           END DO  
           DO j = 1, knon  
              i = ni(j)  
              ycdragh(j) = ycdragh(j) * ypct(j)  
              ycdragm(j) = ycdragm(j) * ypct(j)  
           END DO  
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)
# Line 464  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) + ycdragh(j)               cdragh(i) = cdragh(i) + ycdragh(j) * ypct(j)
418               cdragm(i) = cdragm(i) + ycdragm(j)               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)
421            END DO            END DO
# Line 490  contains Line 440  contains
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)
441               END DO               END DO
442            END DO            END DO
443              
444            ycoefh(ni(:knon), 2:) = ycoefh(ni(:knon), 2:) + coefh(:knon, :)            forall (k = 2:klev) coefh(ni(:knon), k) &
445            ycoefh(ni(:knon), 1) = ycoefh(ni(:knon), 1) + ycdragh(:knon)                 = 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    
# Line 517  contains Line 467  contains
467    
468            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
469                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
470                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar(:knon))
471    
472            DO j = 1, knon            DO j = 1, knon
473               i = ni(j)               i = ni(j)
Legend:
Removed from v.241  
changed lines
  Added in v.250
  ViewVC Help
Powered by ViewVC 1.1.21