/[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 101 by guez, Mon Jul 7 17:45:21 2014 UTC trunk/Sources/phylmd/clmain.f revision 175 by guez, Fri Feb 5 16:02:34 2016 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)
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 38  contains Line 38  contains
38      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
39      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
40      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
41        use stdlevvar_m, only: stdlevvar
42      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
43      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
44      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
# Line 56  contains Line 57  contains
57      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
58      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
59      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere
60      REAL, INTENT(IN):: ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
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 70  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 82  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 99  contains Line 101  contains
101      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
102      ! changement pour "u" et "v"      ! changement pour "u" et "v"
103    
104      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
105    
106      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
107      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
# Line 148  contains Line 149  contains
149      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
150      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
151    
     REAL flux_o(klon), flux_g(klon)  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
   
152      ! Local:      ! Local:
153    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
154      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
155      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
156    
# Line 170  contains Line 160  contains
160    
161      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
162      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
163      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
164      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
165      ! la premiere couche      ! la premiere couche
# Line 185  contains Line 174  contains
174      REAL ysnow_f(klon)      REAL ysnow_f(klon)
175      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
176    
     REAL ysollw(klon), ysolsw(klon)  
177      REAL yfder(klon)      REAL yfder(klon)
178      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
179    
# Line 217  contains Line 205  contains
205      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
206    
207      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
208      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
209      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
210    
211      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
# Line 280  contains Line 268  contains
268      yts = 0.      yts = 0.
269      ysnow = 0.      ysnow = 0.
270      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
271      yrain_f = 0.      yrain_f = 0.
272      ysnow_f = 0.      ysnow_f = 0.
273      yfder = 0.      yfder = 0.
     ysolsw = 0.  
     ysollw = 0.  
274      yrugos = 0.      yrugos = 0.
275      yu1 = 0.      yu1 = 0.
276      yv1 = 0.      yv1 = 0.
# Line 305  contains Line 289  contains
289      y_dflux_q = 0.      y_dflux_q = 0.
290      ytsoil = 999999.      ytsoil = 999999.
291      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
292      yu10mx = 0.      yu10mx = 0.
293      yu10my = 0.      yu10my = 0.
294      ywindsp = 0.      ywindsp = 0.
     ! -- LOOP  
295      d_ts = 0.      d_ts = 0.
296      yfluxlat = 0.      yfluxlat = 0.
297      flux_t = 0.      flux_t = 0.
# Line 322  contains Line 304  contains
304      d_v = 0.      d_v = 0.
305      ycoefh = 0.      ycoefh = 0.
306    
307      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
308      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
309      ! (à affiner)      ! (\`a affiner)
310    
311      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
312      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
# Line 337  contains Line 319  contains
319         ni = 0         ni = 0
320         knon = 0         knon = 0
321         DO i = 1, klon         DO i = 1, klon
322            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
323            ! "potentielles"            ! "potentielles"
324            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
325               knon = knon + 1               knon = knon + 1
# Line 350  contains Line 332  contains
332               i = ni(j)               i = ni(j)
333               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
334               yts(j) = ts(i, nsrf)               yts(j) = ts(i, nsrf)
              ytslab(i) = tslab(i)  
335               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
336               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
337               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
338               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
339               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
340               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
341               yfder(j) = fder(i)               yfder(j) = fder(i)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
342               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
343               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
344               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
345               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
346               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
347               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
348               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
349               yu10mx(j) = u10m(i, nsrf)               yu10mx(j) = u10m(i, nsrf)
# Line 424  contains Line 402  contains
402            END IF            END IF
403    
404            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
405               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
406               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
407               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
408                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
409                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 455  contains Line 433  contains
433               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
434               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
435    
436               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
437    
438               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
439                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
440                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
441                       yustar, iflag_pbl)                       iflag_pbl)
442               ELSE               ELSE
443                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
444                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 477  contains Line 455  contains
455                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
456    
457            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
458            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
459                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
460                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
461                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
462                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &
463                 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, &
464                 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)
465    
466            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
467            yrugm = 0.            yrugm = 0.
# Line 519  contains Line 497  contains
497    
498            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
499    
500            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
501            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
502            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
503            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 528  contains Line 505  contains
505            DO j = 1, knon            DO j = 1, knon
506               i = ni(j)               i = ni(j)
507               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
508               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
509               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
510               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
511               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 556  contains Line 532  contains
532                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
533               END DO               END DO
534            END IF            END IF
535            !$$$ PB ajout pour soil  
536            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
537            DO k = 1, nsoilmx            DO k = 1, nsoilmx
538               DO j = 1, knon               DO j = 1, knon
# Line 612  contains Line 588  contains
588    
589            END DO            END DO
590    
591            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
592                 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, &
593                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
594    
# Line 636  contains Line 612  contains
612                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
613               END DO               END DO
614            END DO            END DO
           !IM "slab" ocean  
           IF (nsrf == is_oce) THEN  
              DO j = 1, knon  
                 ! on projette sur la grille globale  
                 i = ni(j)  
                 IF (pctsrf_new(i, is_oce)>epsfra) THEN  
                    flux_o(i) = y_flux_o(j)  
                 ELSE  
                    flux_o(i) = 0.  
                 END IF  
              END DO  
           END IF  
   
           IF (nsrf == is_sic) THEN  
              DO j = 1, knon  
                 i = ni(j)  
                 ! On pondère lorsque l'on fait le bilan au sol :  
                 IF (pctsrf_new(i, is_sic)>epsfra) THEN  
                    flux_g(i) = y_flux_g(j)  
                 ELSE  
                    flux_g(i) = 0.  
                 END IF  
              END DO  
   
           END IF  
615         end IF if_knon         end IF if_knon
616      END DO loop_surface      END DO loop_surface
617    
Legend:
Removed from v.101  
changed lines
  Added in v.175
  ViewVC Help
Powered by ViewVC 1.1.21