/[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

trunk/phylmd/clmain.f revision 106 by guez, Tue Sep 9 12:54:30 2014 UTC trunk/Sources/phylmd/clmain.f revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC
# Line 6  contains Line 6  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         paprs, pplay, snow, qsurf, evap, falbe, fluxlat, rain_fall, snow_f, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, d_q, d_u, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, capcl, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &
14         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)         ffonte, run_off_lic_0, flux_o, flux_g, tslab)
15    
16      ! 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
17      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
# Line 19  contains Line 19  contains
19    
20      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
21      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
22      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
23      ! sol.      ! de sol.
24    
25      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
26      ! dans la première couche, trois champs ont été créés : "ycoefh",      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
27      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
28      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
29    
30      use clqh_m, only: clqh      use clqh_m, only: clqh
31      use clvent_m, only: clvent      use clvent_m, only: clvent
# Line 61  contains Line 61  contains
61      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
62      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
63      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
64      REAL ftsoil(klon, nsoilmx, nbsrf)  
65        REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
66        ! soil temperature of surface fraction
67    
68      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: qsol(klon)
69      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 71  contains Line 73  contains
73      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
74      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
75      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
76      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
77    
78      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
79    
# Line 83  contains Line 84  contains
84      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
85    
86      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
87      REAL fder(klon)      REAL, intent(in):: fder(klon)
88      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
89    
90      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
91      ! rugos----input-R- longeur de rugosite (en m)      ! rugos----input-R- longeur de rugosite (en m)
# Line 170  contains Line 171  contains
171    
172      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
173      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
174      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
175      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
176      ! la premiere couche      ! la premiere couche
# Line 217  contains Line 217  contains
217      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
218    
219      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
220      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
221      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
222    
223      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
# Line 280  contains Line 280  contains
280      yts = 0.      yts = 0.
281      ysnow = 0.      ysnow = 0.
282      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
283      yrain_f = 0.      yrain_f = 0.
284      ysnow_f = 0.      ysnow_f = 0.
285      yfder = 0.      yfder = 0.
# Line 320  contains Line 318  contains
318      d_v = 0.      d_v = 0.
319      ycoefh = 0.      ycoefh = 0.
320    
321      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
322      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
323      ! (à affiner)      ! (\`a affiner)
324    
325      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
326      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
# Line 335  contains Line 333  contains
333         ni = 0         ni = 0
334         knon = 0         knon = 0
335         DO i = 1, klon         DO i = 1, klon
336            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
337            ! "potentielles"            ! "potentielles"
338            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
339               knon = knon + 1               knon = knon + 1
# Line 351  contains Line 349  contains
349               ytslab(i) = tslab(i)               ytslab(i) = tslab(i)
350               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
351               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
352               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
353               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
354               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
355               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
# Line 422  contains Line 419  contains
419            END IF            END IF
420    
421            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
422               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
423               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
424               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
425                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
426                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 453  contains Line 450  contains
450               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
451               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
452    
453               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
454    
455               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
456                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
457                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
458                       yustar, iflag_pbl)                       iflag_pbl)
459               ELSE               ELSE
460                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
461                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 475  contains Line 472  contains
472                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
473    
474            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
475            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
476                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, yv1, &                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
477                 coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, yrads, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
478                 yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, ysolsw, &                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
479                 yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts(:knon), &                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &
480                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
481                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g)                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &
482                   y_flux_g)
483    
484            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
485            yrugm = 0.            yrugm = 0.
# Line 517  contains Line 515  contains
515    
516            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
517    
518            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
519            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
520            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
521            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 526  contains Line 523  contains
523            DO j = 1, knon            DO j = 1, knon
524               i = ni(j)               i = ni(j)
525               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
526               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
527               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
528               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
529               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 554  contains Line 550  contains
550                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
551               END DO               END DO
552            END IF            END IF
553            !$$$ PB ajout pour soil  
554            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
555            DO k = 1, nsoilmx            DO k = 1, nsoilmx
556               DO j = 1, knon               DO j = 1, knon
# Line 610  contains Line 606  contains
606    
607            END DO            END DO
608    
609            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
610                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &
611                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
612    
# Line 650  contains Line 646  contains
646            IF (nsrf == is_sic) THEN            IF (nsrf == is_sic) THEN
647               DO j = 1, knon               DO j = 1, knon
648                  i = ni(j)                  i = ni(j)
649                  ! On pondère lorsque l'on fait le bilan au sol :                  ! On pond\`ere lorsque l'on fait le bilan au sol :
650                  IF (pctsrf_new(i, is_sic)>epsfra) THEN                  IF (pctsrf_new(i, is_sic)>epsfra) THEN
651                     flux_g(i) = y_flux_g(j)                     flux_g(i) = y_flux_g(j)
652                  ELSE                  ELSE
Legend:
Removed from v.106  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21