/[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 223 by guez, Fri Apr 28 13:22:36 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, julien, mu0, ftsol, cdmmax, &
8         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, fsolsw, fsollw, frugs, &
10         solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, d_q, d_u, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, capcl, &         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &         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):: julien ! 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):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
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):: 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 81  contains Line 79  contains
79      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_f(klon)
80      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83      REAL, intent(in):: fder(klon)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
     REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es  
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
84      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 99  contains Line 91  contains
91      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
92      ! changement pour "u" et "v"      ! changement pour "u" et "v"
93    
94      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95    
96        REAL, intent(out):: flux_t(klon, nbsrf)
97        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
98        ! le bas) à la surface
99    
100      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
101      ! 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
102      !                    (orientation positive vers le bas)  
103      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104        ! 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  
105    
106      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
107      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 116  contains Line 109  contains
109      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
110      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
111      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
112      !IM "slab" ocean      ! IM "slab" ocean
113    
114      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
115      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
116      REAL zv1(klon)      REAL zv1(klon)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
119    
120      ! Ionela Musat cf. Anne Mathieu : pbl, hbtm (Comme les autres      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
121      ! diagnostics on cumule dans physiq ce qui permet de sortir les      ! (Comme les autres diagnostics on cumule dans physiq ce qui
122      ! grandeurs par sous-surface)      ! permet de sortir les grandeurs par sous-surface)
123      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
     ! pblh------- HCL  
124      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
125      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
126      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
127      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
128      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
129      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
130      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 150  contains Line 141  contains
141    
142      ! Local:      ! Local:
143    
144        LOGICAL:: firstcal = .true.
145    
146        ! la nouvelle repartition des surfaces sortie de l'interface
147        REAL, save:: pctsrf_new_oce(klon)
148        REAL, save:: pctsrf_new_sic(klon)
149    
150      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
151      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
152      REAL rugmer(klon)      REAL rugmer(klon)
   
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
154      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
155      REAL yalb(klon)      REAL yalb(klon)
156    
157      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
158      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
159      ! la premiere couche      ! la premi\`ere couche.
160      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
161        REAL snow(klon), yqsurf(klon), yagesno(klon)
162    
163      real yqsol(klon)      real yqsol(klon)
164      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 173  contains Line 169  contains
169      REAL ysnow_f(klon)      REAL ysnow_f(klon)
170      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
171    
     REAL yfder(klon)  
172      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
173      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
174      REAL y_d_ts(klon)      REAL y_d_ts(klon)
175      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
176      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
177      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
178      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
179      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
180      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
181      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 207  contains Line 200  contains
200      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
201      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
202    
203      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
204    
205      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
206      REAL yustar(klon)      REAL yustar(klon)
# Line 259  contains Line 252  contains
252      zu1 = 0.      zu1 = 0.
253      zv1 = 0.      zv1 = 0.
254      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
255      yqsurf = 0.      yqsurf = 0.
256      yrain_f = 0.      yrain_f = 0.
257      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
258      yrugos = 0.      yrugos = 0.
259      yu1 = 0.      yu1 = 0.
260      yv1 = 0.      yv1 = 0.
     yrads = 0.  
261      ypaprs = 0.      ypaprs = 0.
262      ypplay = 0.      ypplay = 0.
263      ydelp = 0.      ydelp = 0.
# Line 276  contains Line 265  contains
265      yv = 0.      yv = 0.
266      yt = 0.      yt = 0.
267      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
268      y_dflux_t = 0.      y_dflux_t = 0.
269      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
270      yrugoro = 0.      yrugoro = 0.
271      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
272      flux_t = 0.      flux_t = 0.
273      flux_q = 0.      flux_q = 0.
274      flux_u = 0.      flux_u = 0.
275      flux_v = 0.      flux_v = 0.
276        fluxlat = 0.
277      d_t = 0.      d_t = 0.
278      d_q = 0.      d_q = 0.
279      d_u = 0.      d_u = 0.
# Line 299  contains Line 284  contains
284      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
285      ! (\`a affiner)      ! (\`a affiner)
286    
287      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
288        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
289      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
290      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
291    
292        ! Tester si c'est le moment de lire le fichier:
293        if (mod(itap - 1, lmt_pas) == 0) then
294           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
295        endif
296    
297      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
298    
299      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 322  contains Line 313  contains
313            DO j = 1, knon            DO j = 1, knon
314               i = ni(j)               i = ni(j)
315               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
316               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
317               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
318               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
319               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
320               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
321               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
322               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
323               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              yrugos(j) = rugos(i, nsrf)  
324               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
325               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
326               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
327               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
328               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
329               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
330            END DO            END DO
# Line 346  contains Line 336  contains
336               yqsol = 0.               yqsol = 0.
337            END IF            END IF
338    
339            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  
340    
341            DO k = 1, klev            DO k = 1, klev
342               DO j = 1, knon               DO j = 1, knon
# Line 367  contains Line 352  contains
352            END DO            END DO
353    
354            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
355            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
356                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
357                   coefh(:knon, :))
358            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
359               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
360               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 438  contains Line 424  contains
424    
425            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
426            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
427                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
428            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
429                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
430    
431            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
432            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
433                 pctsrf, ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
434                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
435                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
436                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
437                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 y_d_t, y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &
438                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_flux_q(:knon), y_dflux_t(:knon), y_dflux_q(:knon), &
439                   y_fqcalving, y_ffonte, y_run_off_lic_0)
440    
441            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
442            yrugm = 0.            yrugm = 0.
# Line 474  contains Line 461  contains
461                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
462                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
463                  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)  
464                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
465                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
466               END DO               END DO
467            END DO            END DO
468    
469            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
470              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
471              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
472              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
473    
474              evap(:, nsrf) = -flux_q(:, nsrf)
475    
476            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
477            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
478            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
479            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
482               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
483               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
484               snow(i, nsrf) = ysnow(j)               fsnow(i, nsrf) = snow(j)
485               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
486               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
487               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
488               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
489                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
490                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
491               END IF               END IF
492               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
493               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 522  contains Line 509  contains
509            END IF            END IF
510    
511            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
512            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  
513    
514            DO j = 1, knon            DO j = 1, knon
515               i = ni(j)               i = ni(j)
# Line 553  contains Line 535  contains
535               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
536               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
537               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
538                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
539               END IF               END IF
540               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
541               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 573  contains Line 555  contains
555               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
556               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)
557               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)
   
558            END DO            END DO
559    
560            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
561                 y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
562                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
563    
564            DO j = 1, knon            DO j = 1, knon
565               i = ni(j)               i = ni(j)
# Line 600  contains Line 581  contains
581                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
582               END DO               END DO
583            END DO            END DO
584           else
585              fsnow(:, nsrf) = 0.
586         end IF if_knon         end IF if_knon
587      END DO loop_surface      END DO loop_surface
588    
589      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
590        frugs(:, is_oce) = rugmer
591        pctsrf(:, is_oce) = pctsrf_new_oce
592        pctsrf(:, is_sic) = pctsrf_new_sic
593    
594      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
595    
596    END SUBROUTINE clmain    END SUBROUTINE clmain
597    
Legend:
Removed from v.186  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.21