/[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 149 by guez, Thu Jun 18 12:23:44 2015 UTC
# 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 83  contains Line 86  contains
86    
87      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
88      REAL fder(klon)      REAL fder(klon)
89      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
90    
91      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
92      ! rugos----input-R- longeur de rugosite (en m)      ! rugos----input-R- longeur de rugosite (en m)
# Line 99  contains Line 102  contains
102      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
103      ! changement pour "u" et "v"      ! changement pour "u" et "v"
104    
105      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
106    
107      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
108      ! 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 217  contains Line 219  contains
219      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
220    
221      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
222      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
223      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
224    
225      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
# Line 305  contains Line 307  contains
307      y_dflux_q = 0.      y_dflux_q = 0.
308      ytsoil = 999999.      ytsoil = 999999.
309      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
310      yu10mx = 0.      yu10mx = 0.
311      yu10my = 0.      yu10my = 0.
312      ywindsp = 0.      ywindsp = 0.
     ! -- LOOP  
313      d_ts = 0.      d_ts = 0.
314      yfluxlat = 0.      yfluxlat = 0.
315      flux_t = 0.      flux_t = 0.
# Line 322  contains Line 322  contains
322      d_v = 0.      d_v = 0.
323      ycoefh = 0.      ycoefh = 0.
324    
325      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
326      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
327      ! (à affiner)      ! (\`a affiner)
328    
329      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
330      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
# Line 337  contains Line 337  contains
337         ni = 0         ni = 0
338         knon = 0         knon = 0
339         DO i = 1, klon         DO i = 1, klon
340            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
341            ! "potentielles"            ! "potentielles"
342            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
343               knon = knon + 1               knon = knon + 1
# Line 424  contains Line 424  contains
424            END IF            END IF
425    
426            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
427               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
428               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
429               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
430                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
431                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 455  contains Line 455  contains
455               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
456               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
457    
458               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
459    
460               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
461                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
462                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
463                       yustar, iflag_pbl)                       iflag_pbl)
464               ELSE               ELSE
465                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
466                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 477  contains Line 477  contains
477                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
478    
479            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
480            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
481                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
482                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
483                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
484                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &
485                 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, &
486                 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, &
487                   y_flux_g)
488    
489            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
490            yrugm = 0.            yrugm = 0.
# Line 556  contains Line 557  contains
557                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
558               END DO               END DO
559            END IF            END IF
560            !$$$ PB ajout pour soil  
561            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
562            DO k = 1, nsoilmx            DO k = 1, nsoilmx
563               DO j = 1, knon               DO j = 1, knon
# Line 612  contains Line 613  contains
613    
614            END DO            END DO
615    
616            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
617                 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, &
618                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
619    
# Line 652  contains Line 653  contains
653            IF (nsrf == is_sic) THEN            IF (nsrf == is_sic) THEN
654               DO j = 1, knon               DO j = 1, knon
655                  i = ni(j)                  i = ni(j)
656                  ! On pondère lorsque l'on fait le bilan au sol :                  ! On pond\`ere lorsque l'on fait le bilan au sol :
657                  IF (pctsrf_new(i, is_sic)>epsfra) THEN                  IF (pctsrf_new(i, is_sic)>epsfra) THEN
658                     flux_g(i) = y_flux_g(j)                     flux_g(i) = y_flux_g(j)
659                  ELSE                  ELSE
Legend:
Removed from v.101  
changed lines
  Added in v.149
  ViewVC Help
Powered by ViewVC 1.1.21