/[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 226 by guez, Mon Oct 16 13:04:05 2017 UTC revision 236 by guez, Thu Nov 9 12:47:25 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 conf_gcm_m, ONLY: prt_level, lmt_pas      use coefkz2_m, only: coefkz2
29        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
32      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# 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 152  contains Line 152  contains
152      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
153      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
154      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
155      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
156      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
157      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 172  contains Line 168  contains
168      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
169      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
170      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
   
171      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
172        REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
     REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)  
173      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
174      REAL ykmq(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)
181      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
182      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
183    
184      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
185      REAL yustar(klon)      REAL ustar(klon)
186    
187      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
188      REAL ypblh(klon)      REAL ypblh(klon)
# Line 204  contains Line 195  contains
195      REAL ytrmb1(klon)      REAL ytrmb1(klon)
196      REAL ytrmb2(klon)      REAL ytrmb2(klon)
197      REAL ytrmb3(klon)      REAL ytrmb3(klon)
198      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
199      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
200      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
201    
202      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
203      REAL rugo1(klon)      REAL rugo1(klon)
204    
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
   
205      !------------------------------------------------------------      !------------------------------------------------------------
206    
207      ytherm = 0.      ytherm = 0.
# Line 300  contains Line 287  contains
287               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
288               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
289               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
290               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
291               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
292               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
# Line 327  contains Line 312  contains
312    
313            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
314            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
315                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, 2:), &
316                 coefh(:knon, :))                 coefh(:knon, 2:), coefm(:knon, 1), coefh(:knon, 1))
317    
318            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
319               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, 2:), &
320                      ycoefh0(:knon, 2:))
321                 ycoefm0(:knon, 1) = 0.
322                 ycoefh0(:knon, 1) = 0.
323               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
324               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
325            END IF            END IF
# Line 344  contains Line 333  contains
333            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
334               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
335               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
336                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0(:knon, 2:), ycoefh0(:knon, 2:))
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(1:knon, k) = yzlay(1: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)) &
351                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
352                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
353               END DO               END DO
354    
355               DO k = 1, klev               DO k = 1, klev
356                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
357                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
358               END DO               END DO
359               yzlev(1:knon, 1) = 0.  
360               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
361                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
362                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
363    
364               DO k = 2, klev               DO k = 2, klev
365                  yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))                  zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))
366               END DO               END DO
367    
368               DO k = 1, klev + 1               DO k = 1, klev + 1
369                  DO j = 1, knon                  DO j = 1, knon
370                     i = ni(j)                     i = ni(j)
# Line 378  contains Line 372  contains
372                  END DO                  END DO
373               END DO               END DO
374    
375               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
376               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
377                      yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
378               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                    coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
379                      ykmn(:knon, :), ykmq(:knon, :), ustar(:knon))
              IF (iflag_pbl >= 11) THEN  
                 CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &  
                      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  
   
380               coefm(:knon, 2:) = ykmm(:knon, 2:klev)               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
381               coefh(:knon, 2:) = ykmn(:knon, 2:klev)               coefh(:knon, 2:) = ykmn(:knon, 2:klev)
382            END IF            END IF
383    
384            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
385            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &                 coefm(:knon, 1), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
386                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
387                 y_flux_u(:knon))                 y_flux_u(:knon))
388            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
389                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 coefm(:knon, 1), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
390                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
391                 y_flux_v(:knon))                 y_flux_v(:knon))
392    
393            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
394            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
395                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
396                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, 2:), coefh(:knon, 1), &
397                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
398                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
399                 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, &
400                 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), &
401                 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, &
402                   y_run_off_lic_0)
403    
404            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
405            yrugm = 0.            yrugm = 0.
406            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
407               DO j = 1, knon               DO j = 1, knon
408                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &                  yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &
409                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
410                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
411                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
412               END DO               END DO
413            END IF            END IF
# Line 499  contains Line 486  contains
486    
487            DO j = 1, knon            DO j = 1, knon
488               i = ni(j)               i = ni(j)
489               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
490               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
491               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
492               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
493               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 503  contains
503               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
504            END DO            END DO
505    
506            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
507                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
508                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
509    
510            DO j = 1, knon            DO j = 1, knon
511               i = ni(j)               i = ni(j)
512               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
513               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
514    
515               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
516                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
517               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
518                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
519            END DO            END DO
520    
521            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
522                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
523                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
524    
Legend:
Removed from v.226  
changed lines
  Added in v.236
  ViewVC Help
Powered by ViewVC 1.1.21