/[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 186 by guez, Mon Mar 21 15:36:26 2016 UTC revision 206 by guez, Tue Aug 30 12:52:46 2016 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ts, cdmmax, &
8         ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9         paprs, pplay, snow, qsurf, evap, falbe, fluxlat, rain_fall, snow_f, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, d_q, d_u, &         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, capcl, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        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 31  contains Line 30  contains
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
38      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
39        USE interfoce_lim_m, ONLY: interfoce_lim
40      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42        use time_phylmdz, only: itap
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
45      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
46    
47      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
# Line 68  contains Line 67  contains
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL snow(klon, nbsrf)      REAL, INTENT(inout):: snow(klon, nbsrf)
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
# Line 85  contains Line 84  contains
84      REAL, intent(in):: fder(klon)      REAL, intent(in):: fder(klon)
85      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
86    
87      REAL rugos(klon, nbsrf)      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
     ! rugos----input-R- longeur de rugosite (en m)  
88    
     LOGICAL, INTENT(IN):: debut  
89      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
90      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
91    
# Line 101  contains Line 98  contains
98    
99      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
100    
101      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
102      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
103      !                    (orientation positive vers le bas)      ! le bas) à la surface
104      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
105        REAL, intent(out):: flux_q(klon, nbsrf)
106      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      ! flux de vapeur d'eau (kg/m2/s) à la surface
107      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
108      ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
109        ! tension du vent à la surface, en Pa
110    
111      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
112      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 116  contains Line 114  contains
114      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
115      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
116      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
117      !IM "slab" ocean      ! IM "slab" ocean
118    
119      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
120      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 124  contains Line 122  contains
122      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
123      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
124    
125      ! Ionela Musat cf. Anne Mathieu : pbl, hbtm (Comme les autres      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
126      ! diagnostics on cumule dans physiq ce qui permet de sortir les      ! (Comme les autres diagnostics on cumule dans physiq ce qui
127      ! grandeurs par sous-surface)      ! permet de sortir les grandeurs par sous-surface)
128      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
     ! pblh------- HCL  
129      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
130      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
131      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 150  contains Line 147  contains
147    
148      ! Local:      ! Local:
149    
150        LOGICAL:: firstcal = .true.
151    
152        ! la nouvelle repartition des surfaces sortie de l'interface
153        REAL, save:: pctsrf_new_oce(klon)
154        REAL, save:: pctsrf_new_sic(klon)
155    
156      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
157      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
158    
# Line 181  contains Line 184  contains
184      REAL y_d_ts(klon)      REAL y_d_ts(klon)
185      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
186      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
187      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
188      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
189      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
190      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
191      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 207  contains Line 210  contains
210      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
211      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
212    
213      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
214    
215      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
216      REAL yustar(klon)      REAL yustar(klon)
# Line 276  contains Line 279  contains
279      yv = 0.      yv = 0.
280      yt = 0.      yt = 0.
281      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
282      y_dflux_t = 0.      y_dflux_t = 0.
283      y_dflux_q = 0.      y_dflux_q = 0.
284      ytsoil = 999999.      ytsoil = 999999.
# Line 299  contains Line 299  contains
299      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
300      ! (\`a affiner)      ! (\`a affiner)
301    
302      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
303        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
304      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
305      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
306    
307        ! Tester si c'est le moment de lire le fichier:
308        if (mod(itap - 1, lmt_pas) == 0) then
309           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
310        endif
311    
312      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
313    
314      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 438  contains Line 444  contains
444    
445            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
446            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
447                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
448            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
449                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
450    
451            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
452            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &
453                 pctsrf, ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, &                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
454                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yq, yts, ypaprs, ypplay, ydelp, yrads, yalb(:knon), ysnow, &
455                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, pctsrf_new_sic, &
456                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &                 yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), yz0_new, &
457                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, y_dflux_q, &
458                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_fqcalving, y_ffonte, y_run_off_lic_0)
459    
460            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
461            yrugm = 0.            yrugm = 0.
# Line 474  contains Line 480  contains
480                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
481                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
482                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
483                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
484                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
485               END DO               END DO
486            END DO            END DO
487    
488            evap(:, nsrf) = -flux_q(:, 1, nsrf)            DO j = 1, knon
489                 i = ni(j)
490                 flux_t(i, nsrf) = y_flux_t(j)
491                 flux_q(i, nsrf) = y_flux_q(j)
492                 flux_u(i, nsrf) = y_flux_u(j)
493                 flux_v(i, nsrf) = y_flux_v(j)
494              END DO
495    
496              evap(:, nsrf) = -flux_q(:, nsrf)
497    
498            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
499            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
# Line 576  contains Line 586  contains
586    
587            END DO            END DO
588    
589            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
590                 y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
591                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
592    
593            DO j = 1, knon            DO j = 1, knon
594               i = ni(j)               i = ni(j)
# Line 604  contains Line 614  contains
614      END DO loop_surface      END DO loop_surface
615    
616      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
617      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
618      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
619        pctsrf(:, is_sic) = pctsrf_new_sic
620    
621        firstcal = .false.
622    
623    END SUBROUTINE clmain    END SUBROUTINE clmain
624    
Legend:
Removed from v.186  
changed lines
  Added in v.206
  ViewVC Help
Powered by ViewVC 1.1.21