/[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 175 by guez, Fri Feb 5 16:02:34 2016 UTC revision 215 by guez, Tue Mar 28 12:46:28 2017 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, mu0, ftsol, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
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, &         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
     USE dimens_m, ONLY: iim, jjm  
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):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temp\'erature du sol (en K)
     REAL, INTENT(IN):: ts(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 70  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):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
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)
74        REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
77      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg/m2/s), positive down
# Line 85  contains Line 81  contains
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
83      REAL, intent(in):: fder(klon)      REAL, intent(in):: fder(klon)
84      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
85      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
86      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
87    
# Line 101  contains Line 92  contains
92      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
93      ! changement pour "u" et "v"      ! changement pour "u" et "v"
94    
95      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour ftsol
96    
97        REAL, intent(out):: flux_t(klon, nbsrf)
98        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
99        ! le bas) à la surface
100    
101        REAL, intent(out):: flux_q(klon, nbsrf)
102        ! flux de vapeur d'eau (kg/m2/s) à la surface
103    
104      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
105      ! 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  
106    
107      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
108      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 118  contains Line 110  contains
110      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
111      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
112      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
113      !IM "slab" ocean      ! IM "slab" ocean
114    
115      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
116      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 126  contains Line 118  contains
118      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
119      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
120    
121      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
122      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
123      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
124      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 151  contains Line 143  contains
143    
144      ! Local:      ! Local:
145    
146        LOGICAL:: firstcal = .true.
147    
148        ! la nouvelle repartition des surfaces sortie de l'interface
149        REAL, save:: pctsrf_new_oce(klon)
150        REAL, save:: pctsrf_new_sic(klon)
151    
152      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
153      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
154      REAL rugmer(klon)      REAL rugmer(klon)
   
155      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
156      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
157      REAL yalb(klon)      REAL yalb(klon)
158    
159      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
160      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
161      ! la premiere couche      ! la premi\`ere couche.
162      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
163        REAL snow(klon), yqsurf(klon), yagesno(klon)
164    
165      real yqsol(klon)      real yqsol(klon)
166      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 176  contains Line 173  contains
173    
174      REAL yfder(klon)      REAL yfder(klon)
175      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
176      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
177      REAL y_d_ts(klon)      REAL y_d_ts(klon)
178      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
179      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
180      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
181      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
182      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
183      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
184      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 208  contains Line 203  contains
203      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
204      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
205    
206      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
207    
208      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
209      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
210    
211      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
212      REAL ypblh(klon)      REAL ypblh(klon)
# Line 266  contains Line 256  contains
256      zv1 = 0.      zv1 = 0.
257      ypct = 0.      ypct = 0.
258      yts = 0.      yts = 0.
     ysnow = 0.  
259      yqsurf = 0.      yqsurf = 0.
260      yrain_f = 0.      yrain_f = 0.
261      ysnow_f = 0.      ysnow_f = 0.
# Line 282  contains Line 271  contains
271      yv = 0.      yv = 0.
272      yt = 0.      yt = 0.
273      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
274      y_dflux_t = 0.      y_dflux_t = 0.
275      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
276      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
277      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
278      flux_t = 0.      flux_t = 0.
279      flux_q = 0.      flux_q = 0.
280      flux_u = 0.      flux_u = 0.
281      flux_v = 0.      flux_v = 0.
282        fluxlat = 0.
283      d_t = 0.      d_t = 0.
284      d_q = 0.      d_q = 0.
285      d_u = 0.      d_u = 0.
# Line 308  contains Line 290  contains
290      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
291      ! (\`a affiner)      ! (\`a affiner)
292    
293      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
294        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
295      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
296      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
297    
298        ! Tester si c'est le moment de lire le fichier:
299        if (mod(itap - 1, lmt_pas) == 0) then
300           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
301        endif
302    
303      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
304    
305      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 331  contains Line 319  contains
319            DO j = 1, knon            DO j = 1, knon
320               i = ni(j)               i = ni(j)
321               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
322               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
323               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
324               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
325               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
326               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
# Line 346  contains Line 334  contains
334               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
335               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
336               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
              yu10mx(j) = u10m(i, nsrf)  
              yu10my(j) = v10m(i, nsrf)  
              ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))  
337            END DO            END DO
338    
339            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 358  contains Line 343  contains
343               yqsol = 0.               yqsol = 0.
344            END IF            END IF
345    
346            DO k = 1, nsoilmx            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
              DO j = 1, knon  
                 i = ni(j)  
                 ytsoil(j, k) = ftsoil(i, k, nsrf)  
              END DO  
           END DO  
347    
348            DO k = 1, klev            DO k = 1, klev
349               DO j = 1, knon               DO j = 1, knon
# Line 379  contains Line 359  contains
359            END DO            END DO
360    
361            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
362            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, yu, &
363                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
364            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
365               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
366               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 450  contains Line 430  contains
430    
431            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
432            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
433                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
434            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
435                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
436    
437            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
438            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &
439                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 yqsol, mu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
440                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
441                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfder, yfluxlat(:knon), &
442                 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), &
443                 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, &
444                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
445    
446            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
# Line 486  contains Line 466  contains
466                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
467                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
468                  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)  
469                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
470                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
471               END DO               END DO
472            END DO            END DO
473    
474            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
475              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
476              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
477              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
478    
479              evap(:, nsrf) = -flux_q(:, nsrf)
480    
481            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
482            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
483            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
484            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
485            DO j = 1, knon            DO j = 1, knon
486               i = ni(j)               i = ni(j)
487               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
488               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
489               snow(i, nsrf) = ysnow(j)               fsnow(i, nsrf) = snow(j)
490               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
491               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
492               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
# Line 534  contains Line 514  contains
514            END IF            END IF
515    
516            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
517            DO k = 1, nsoilmx            ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
              DO j = 1, knon  
                 i = ni(j)  
                 ftsoil(i, k, nsrf) = ytsoil(j, k)  
              END DO  
           END DO  
518    
519            DO j = 1, knon            DO j = 1, knon
520               i = ni(j)               i = ni(j)
# Line 585  contains Line 560  contains
560               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
561               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
562               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
   
563            END DO            END DO
564    
565            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
566                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
567                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
568    
569            DO j = 1, knon            DO j = 1, knon
570               i = ni(j)               i = ni(j)
# Line 612  contains Line 586  contains
586                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
587               END DO               END DO
588            END DO            END DO
589           else
590              fsnow(:, nsrf) = 0.
591         end IF if_knon         end IF if_knon
592      END DO loop_surface      END DO loop_surface
593    
594      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
595      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
596      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
597        pctsrf(:, is_sic) = pctsrf_new_sic
598    
599        firstcal = .false.
600    
601    END SUBROUTINE clmain    END SUBROUTINE clmain
602    

Legend:
Removed from v.175  
changed lines
  Added in v.215

  ViewVC Help
Powered by ViewVC 1.1.21