/[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 145 by guez, Tue Jun 16 15:23:29 2015 UTC revision 213 by guez, Mon Feb 27 15:44:55 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, snow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
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):: snow(klon, nbsrf)
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
74    
75      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
76    
# Line 85  contains Line 81  contains
81      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
82    
83      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84      REAL fder(klon)      REAL, intent(in):: fder(klon)
85      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  
86      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
87      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
88    
# Line 102  contains Line 93  contains
93      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
94      ! changement pour "u" et "v"      ! changement pour "u" et "v"
95    
96      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour ftsol
97    
98        REAL, intent(out):: flux_t(klon, nbsrf)
99        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
100        ! le bas) à la surface
101    
102      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
103      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de vapeur d'eau (kg/m2/s) à la surface
104      !                    (orientation positive vers le bas)  
105      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
106        ! tension du vent à la surface, en Pa
     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  
107    
108      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
109      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 119  contains Line 111  contains
111      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
112      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
113      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
114      !IM "slab" ocean      ! IM "slab" ocean
115    
116      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
117      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 127  contains Line 119  contains
119      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
120      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
121    
122      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
123      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
124      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
125      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
126      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
127      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
128      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 150  contains Line 142  contains
142      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
143      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
144    
     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  
   
145      ! Local:      ! Local:
146    
147      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
148      real ytslab(klon)  
149        ! la nouvelle repartition des surfaces sortie de l'interface
150        REAL, save:: pctsrf_new_oce(klon)
151        REAL, save:: pctsrf_new_sic(klon)
152    
153      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
154      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
155      REAL rugmer(klon)      REAL rugmer(klon)
   
156      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
157      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
158      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
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 rajoute en output yu1 et yv1 qui sont les vents dans
161      ! la premiere couche      ! la premiere couche
# Line 187  contains Line 170  contains
170      REAL ysnow_f(klon)      REAL ysnow_f(klon)
171      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
172    
     REAL ysollw(klon), ysolsw(klon)  
173      REAL yfder(klon)      REAL yfder(klon)
174      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
175    
# Line 196  contains Line 178  contains
178      REAL y_d_ts(klon)      REAL y_d_ts(klon)
179      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
180      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
181      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
182      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
183      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
184      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
185      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 222  contains Line 204  contains
204      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
205      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
206    
207      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
208    
209      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
210      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
211    
212      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
213      REAL ypblh(klon)      REAL ypblh(klon)
# Line 282  contains Line 259  contains
259      yts = 0.      yts = 0.
260      ysnow = 0.      ysnow = 0.
261      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
262      yrain_f = 0.      yrain_f = 0.
263      ysnow_f = 0.      ysnow_f = 0.
264      yfder = 0.      yfder = 0.
     ysolsw = 0.  
     ysollw = 0.  
265      yrugos = 0.      yrugos = 0.
266      yu1 = 0.      yu1 = 0.
267      yv1 = 0.      yv1 = 0.
# Line 300  contains Line 273  contains
273      yv = 0.      yv = 0.
274      yt = 0.      yt = 0.
275      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
276      y_dflux_t = 0.      y_dflux_t = 0.
277      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
278      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
279      d_ts = 0.      d_ts = 0.
280      yfluxlat = 0.      yfluxlat = 0.
281      flux_t = 0.      flux_t = 0.
# Line 326  contains Line 292  contains
292      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
293      ! (\`a affiner)      ! (\`a affiner)
294    
295      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
296        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
297      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
298      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
299    
300        ! Tester si c'est le moment de lire le fichier:
301        if (mod(itap - 1, lmt_pas) == 0) then
302           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
303        endif
304    
305      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
306    
307      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 349  contains Line 321  contains
321            DO j = 1, knon            DO j = 1, knon
322               i = ni(j)               i = ni(j)
323               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
324               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
              ytslab(i) = tslab(i)  
325               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
326               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
327               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
328               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
329               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
330               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
331               yfder(j) = fder(i)               yfder(j) = fder(i)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
332               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
333               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
334               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
335               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
336               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
337               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
338               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))  
339            END DO            END DO
340    
341            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 380  contains Line 345  contains
345               yqsol = 0.               yqsol = 0.
346            END IF            END IF
347    
348            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  
349    
350            DO k = 1, klev            DO k = 1, klev
351               DO j = 1, knon               DO j = 1, knon
# Line 401  contains Line 361  contains
361            END DO            END DO
362    
363            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
364            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, yu, &
365                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))
366            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
367               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
368               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 472  contains Line 432  contains
432    
433            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
434            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
435                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
436            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
437                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
438    
439            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
440            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, jour, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &
441                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 yqsol, mu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &
442                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &
443                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
444                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
445                 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, &
446                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_flux_g)  
447    
448            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
449            yrugm = 0.            yrugm = 0.
# Line 509  contains Line 468  contains
468                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
469                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
470                  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)  
471                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
472                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
473               END DO               END DO
474            END DO            END DO
475    
476            evap(:, nsrf) = -flux_q(:, 1, nsrf)            DO j = 1, knon
477                 i = ni(j)
478                 flux_t(i, nsrf) = y_flux_t(j)
479                 flux_q(i, nsrf) = y_flux_q(j)
480                 flux_u(i, nsrf) = y_flux_u(j)
481                 flux_v(i, nsrf) = y_flux_v(j)
482              END DO
483    
484              evap(:, nsrf) = -flux_q(:, nsrf)
485    
486            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
487            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
488            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
489            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 529  contains Line 491  contains
491            DO j = 1, knon            DO j = 1, knon
492               i = ni(j)               i = ni(j)
493               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
494               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
495               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
496               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
497               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 559  contains Line 520  contains
520            END IF            END IF
521    
522            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
523            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  
524    
525            DO j = 1, knon            DO j = 1, knon
526               i = ni(j)               i = ni(j)
# Line 610  contains Line 566  contains
566               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
567               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)
568               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)
   
569            END DO            END DO
570    
571            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
572                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
573                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
574    
575            DO j = 1, knon            DO j = 1, knon
576               i = ni(j)               i = ni(j)
# Line 637  contains Line 592  contains
592                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
593               END DO               END DO
594            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\`ere 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  
595         end IF if_knon         end IF if_knon
596      END DO loop_surface      END DO loop_surface
597    
598      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
599      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
600      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
601        pctsrf(:, is_sic) = pctsrf_new_sic
602    
603        firstcal = .false.
604    
605    END SUBROUTINE clmain    END SUBROUTINE clmain
606    
Legend:
Removed from v.145  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21