/[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 228 by guez, Fri Nov 3 12:38:47 2017 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, zu1, zv1, t2m, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &
12         q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, &         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         trmb2, trmb3, plcl, fqcalving, 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    
     ! Pour pouvoir extraire les coefficients d'\'echanges et le vent  
     ! 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.  
   
24      use clqh_m, only: clqh      use clqh_m, only: clqh
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 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
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# Line 41  contains Line 36  contains
36      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
37      use time_phylmdz, only: itap      use time_phylmdz, only: itap
38      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
     use vdif_kcay_m, only: vdif_kcay  
39      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
40    
41      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
# Line 112  contains Line 106  contains
106      ! IM "slab" ocean      ! IM "slab" ocean
107    
108      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
109      REAL, intent(out):: zu1(klon), zv1(klon)      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
110        ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
111        ! ce champ sur les quatre sous-surfaces du mod\`ele.
112    
113      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
114    
115      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
# Line 154  contains Line 151  contains
151      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
152      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
153      REAL yalb(klon)      REAL yalb(klon)
   
     REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour  
                               ! une sous-surface donnée  
       
154      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
155      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
156      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 174  contains Line 167  contains
167      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
168      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
169      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
   
170      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
171        REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
     REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)  
172      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
173      REAL ykmq(klon, klev + 1)      REAL ykmq(klon, klev + 1)
174      REAL yq2(klon, klev + 1)      REAL yq2(klon, klev + 1)
     REAL q2diag(klon, klev + 1)  
   
175      REAL delp(klon, klev)      REAL delp(klon, klev)
176      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
177      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
178    
179      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
180      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
181      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
182    
183      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), wind10m(klon)
184      REAL yustar(klon)      REAL ustar(klon)
185    
186      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
187      REAL ypblh(klon)      REAL ypblh(klon)
# Line 206  contains Line 194  contains
194      REAL ytrmb1(klon)      REAL ytrmb1(klon)
195      REAL ytrmb2(klon)      REAL ytrmb2(klon)
196      REAL ytrmb3(klon)      REAL ytrmb3(klon)
197      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
198      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
199      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
200    
201      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
202      REAL rugo1(klon)      REAL rugo1(klon)
203    
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
   
204      !------------------------------------------------------------      !------------------------------------------------------------
205    
206      ytherm = 0.      ytherm = 0.
# Line 233  contains Line 217  contains
217      cdragm = 0.      cdragm = 0.
218      dflux_t = 0.      dflux_t = 0.
219      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
220      ypct = 0.      ypct = 0.
221      yqsurf = 0.      yqsurf = 0.
222      yrain_f = 0.      yrain_f = 0.
# Line 304  contains Line 286  contains
286               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
287               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
288               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              u1lay(j) = u(i, 1)  
              v1lay(j) = v(i, 1)  
289               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
290               ypaprs(j, klev + 1) = paprs(i, klev + 1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
291               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
# Line 333  contains Line 313  contains
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, :))
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, ycoefh0)
319               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 353  contains Line 334  contains
334               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
335            END IF            END IF
336    
337            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
338               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
339               ! Fr\'ed\'eric Hourdin               ! Fr\'ed\'eric Hourdin
340               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
341                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
342                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
343    
344               DO k = 2, klev               DO k = 2, klev
345                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
346                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
347                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
348                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
349               END DO               END DO
350    
351               DO k = 1, klev               DO k = 1, klev
352                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
353                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
354               END DO               END DO
355               yzlev(1:knon, 1) = 0.  
356               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
357                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
358                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
359    
360               DO k = 2, klev               DO k = 2, klev
361                  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))
362               END DO               END DO
363    
364               DO k = 1, klev + 1               DO k = 1, klev + 1
365                  DO j = 1, knon                  DO j = 1, knon
366                     i = ni(j)                     i = ni(j)
# Line 382  contains Line 368  contains
368                  END DO                  END DO
369               END DO               END DO
370    
371               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
              IF (prt_level > 9) PRINT *, 'USTAR = ', yustar  
372    
373               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
374    
375               IF (iflag_pbl >= 11) THEN               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
376                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
377                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &                    coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
378                       iflag_pbl)                    ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), 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  
379    
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"            ! calculer la diffusion des vitesses "u" et "v"
385            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
386                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
387                 y_flux_u(:knon))                 y_flux_u(:knon))
388            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
389                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &                 coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
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                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &
396                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
397                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
398                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
# Line 422  contains Line 403  contains
403            yrugm = 0.            yrugm = 0.
404            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
405               DO j = 1, knon               DO j = 1, knon
406                  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) &
407                       / rg + 0.11 * 14E-6 &                       / rg + 0.11 * 14E-6 &
408                       / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))                       / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
409                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
410               END DO               END DO
411            END IF            END IF
# Line 475  contains Line 456  contains
456               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
457               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
458               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)  
459            END DO            END DO
460            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
461               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 505  contains Line 484  contains
484    
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
487               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
488               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
489               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
490               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
491               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 501  contains
501               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
502            END DO            END DO
503    
504            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
505                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
506                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
507    
508            DO j = 1, knon            DO j = 1, knon
509               i = ni(j)               i = ni(j)
510               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
511               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
512    
513               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
514                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
515               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
516                    / sqrt(uzon(j)**2 + vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
517            END DO            END DO
518    
519            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
520                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
521                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
522    
Legend:
Removed from v.225  
changed lines
  Added in v.228
  ViewVC Help
Powered by ViewVC 1.1.21