/[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 178 by guez, Fri Mar 11 18:47:26 2016 UTC revision 207 by guez, Thu Sep 1 10:30:53 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, ftsol, 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)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temperature du sol (en Kelvin)
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
# 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 99  contains Line 96  contains
96      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97      ! changement pour "u" et "v"      ! changement pour "u" et "v"
98    
99      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ftsol"
100    
101        REAL, intent(out):: flux_t(klon, nbsrf)
102        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
103        ! le bas) à la surface
104    
105        REAL, intent(out):: flux_q(klon, nbsrf)
106        ! flux de vapeur d'eau (kg/m2/s) à la surface
107    
108      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
109      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! tension du vent à la surface, en Pa
     !                    (orientation positive vers le bas)  
     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
   
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
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      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
126      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
127      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
128      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
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 149  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      REAL rugmer(klon)      REAL rugmer(klon)
   
159      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
160      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
161      REAL yalb(klon)      REAL yalb(klon)
162      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
# Line 180  contains Line 181  contains
181      REAL y_d_ts(klon)      REAL y_d_ts(klon)
182      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
183      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
184      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
185      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
186      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
187      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
188      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 206  contains Line 207  contains
207      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
208      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
209    
210      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
211    
212      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
213      REAL yustar(klon)      REAL yustar(klon)
# Line 275  contains Line 276  contains
276      yv = 0.      yv = 0.
277      yt = 0.      yt = 0.
278      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
279      y_dflux_t = 0.      y_dflux_t = 0.
280      y_dflux_q = 0.      y_dflux_q = 0.
281      ytsoil = 999999.      ytsoil = 999999.
# Line 298  contains Line 296  contains
296      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
297      ! (\`a affiner)      ! (\`a affiner)
298    
299      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
300        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
301      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
302      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
303    
304        ! Tester si c'est le moment de lire le fichier:
305        if (mod(itap - 1, lmt_pas) == 0) then
306           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
307        endif
308    
309      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
310    
311      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 321  contains Line 325  contains
325            DO j = 1, knon            DO j = 1, knon
326               i = ni(j)               i = ni(j)
327               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
328               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
329               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
330               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
331               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
# Line 437  contains Line 441  contains
441    
442            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
443            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
444                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
445            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
446                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
447    
448            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
449            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &
450                 pctsrf, ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, &                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
451                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
452                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
453                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
454                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &
455                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
456    
457            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
# Line 473  contains Line 477  contains
477                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
478                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
479                  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)  
480                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
481                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
482               END DO               END DO
483            END DO            END DO
484    
485            evap(:, nsrf) = -flux_q(:, 1, nsrf)            DO j = 1, knon
486                 i = ni(j)
487                 flux_t(i, nsrf) = y_flux_t(j)
488                 flux_q(i, nsrf) = y_flux_q(j)
489                 flux_u(i, nsrf) = y_flux_u(j)
490                 flux_v(i, nsrf) = y_flux_v(j)
491              END DO
492    
493              evap(:, nsrf) = -flux_q(:, nsrf)
494    
495            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
496            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
# Line 575  contains Line 583  contains
583    
584            END DO            END DO
585    
586            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
587                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
588                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589    
590            DO j = 1, knon            DO j = 1, knon
591               i = ni(j)               i = ni(j)
# Line 603  contains Line 611  contains
611      END DO loop_surface      END DO loop_surface
612    
613      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
614      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
615      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
616        pctsrf(:, is_sic) = pctsrf_new_sic
617    
618        firstcal = .false.
619    
620    END SUBROUTINE clmain    END SUBROUTINE clmain
621    
Legend:
Removed from v.178  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21