/[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 207 by guez, Thu Sep 1 10:30:53 2016 UTC revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ftsol, cdmmax, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &         q2m, u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         trmb1, trmb2, trmb3, plcl, fqcalving, 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
# Line 50  contains Line 50  contains
50      ! tableau des pourcentages de surface de chaque maille      ! 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):: ftsol(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 62  contains Line 62  contains
62      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63      ! soil temperature of surface fraction      ! soil temperature of surface fraction
64    
65      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: qsol(:) ! (klon)
66      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
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, INTENT(inout):: 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
78    
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
   
     REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)  
     REAL, intent(in):: fder(klon)  
     REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es  
   
     REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)  
81    
82        REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83        REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
84      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 96  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 "ftsol"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95    
96      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
97      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
98      ! le bas) à la surface      ! le bas) à la surface
99    
100      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
101      ! flux de vapeur d'eau (kg/m2/s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
102    
103      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104      ! tension du vent à la surface, en Pa      ! tension du vent à la surface, en Pa
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)
108    
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
# Line 117  contains Line 112  contains
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), zv1(klon)
116      REAL zv1(klon)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
119        ! composantes du vent \`a 10m sans spirale d'Ekman
120      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm  
121      ! (Comme les autres diagnostics on cumule dans physiq ce qui      ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
122      ! permet de sortir les grandeurs par sous-surface)      ! Comme les autres diagnostics on cumule dans physiq ce qui permet
123        ! de sortir les grandeurs par sous-surface.
124      REAL pblh(klon, nbsrf) ! height of planetary boundary layer      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)
128      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
129      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
130      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
131      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 142  contains Line 137  contains
137      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
138      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
139      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
140      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg / m2 / s
141      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
142    
143      ! Local:      ! Local:
# Line 159  contains Line 154  contains
154      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
155      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156      REAL yalb(klon)      REAL yalb(klon)
     REAL yu1(klon), yv1(klon)  
     ! on rajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premiere couche  
     REAL ysnow(klon), yqsurf(klon), yagesno(klon)  
   
     real yqsol(klon)  
     ! column-density of water in soil, in kg m-2  
157    
158      REAL yrain_f(klon)      REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
159      ! liquid water mass flux (kg/m2/s), positive down                                ! une sous-surface donnée
160        
161      REAL ysnow_f(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
162      ! solid water mass flux (kg/m2/s), positive down      real yqsol(klon) ! column-density of water in soil, in kg m-2
163        REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
164      REAL yfder(klon)      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
165      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
166      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
167      REAL y_d_ts(klon)      REAL y_d_ts(klon)
168      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
169      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
# Line 187  contains Line 173  contains
173      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
174      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
175      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
176      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
177    
178      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
179    
180      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
181      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
182      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
183      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
184      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
185    
     REAL u1lay(klon), v1lay(klon)  
186      REAL delp(klon, klev)      REAL delp(klon, klev)
187      INTEGER i, k, nsrf      INTEGER i, k, nsrf
188    
# Line 207  contains Line 192  contains
192      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
193      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
194    
     REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation  
   
195      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
196      REAL yustar(klon)      REAL yustar(klon)
197    
# Line 240  contains Line 223  contains
223    
224      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
225         DO i = 1, klon         DO i = 1, klon
226            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
227         END DO         END DO
228      END DO      END DO
     DO i = 1, klon ! vent de la premiere couche  
        zx_alf1 = 1.0  
        zx_alf2 = 1.0 - zx_alf1  
        u1lay(i) = u(i, 1)*zx_alf1 + u(i, 2)*zx_alf2  
        v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2  
     END DO  
229    
230      ! Initialization:      ! Initialization:
231      rugmer = 0.      rugmer = 0.
# Line 259  contains Line 236  contains
236      zu1 = 0.      zu1 = 0.
237      zv1 = 0.      zv1 = 0.
238      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
239      yqsurf = 0.      yqsurf = 0.
240      yrain_f = 0.      yrain_f = 0.
241      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
242      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
243      ypaprs = 0.      ypaprs = 0.
244      ypplay = 0.      ypplay = 0.
245      ydelp = 0.      ydelp = 0.
# Line 278  contains Line 249  contains
249      yq = 0.      yq = 0.
250      y_dflux_t = 0.      y_dflux_t = 0.
251      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
252      yrugoro = 0.      yrugoro = 0.
253      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
254      flux_t = 0.      flux_t = 0.
255      flux_q = 0.      flux_q = 0.
256      flux_u = 0.      flux_u = 0.
257      flux_v = 0.      flux_v = 0.
258        fluxlat = 0.
259      d_t = 0.      d_t = 0.
260      d_q = 0.      d_q = 0.
261      d_u = 0.      d_u = 0.
# Line 303  contains Line 273  contains
273    
274      ! Tester si c'est le moment de lire le fichier:      ! Tester si c'est le moment de lire le fichier:
275      if (mod(itap - 1, lmt_pas) == 0) then      if (mod(itap - 1, lmt_pas) == 0) then
276         CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)         CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
277      endif      endif
278    
279      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
# Line 326  contains Line 296  contains
296               i = ni(j)               i = ni(j)
297               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
298               yts(j) = ftsol(i, nsrf)               yts(j) = ftsol(i, nsrf)
299               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
300               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
301               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
302               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
303               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
304               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
305               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              yrugos(j) = rugos(i, nsrf)  
306               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
307               yu1(j) = u1lay(i)               u1lay(j) = u(i, 1)
308               yv1(j) = v1lay(i)               v1lay(j) = v(i, 1)
309               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
310               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
311               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
312            END DO            END DO
313    
314            ! For continent, copy soil water content            ! For continent, copy soil water content
315            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              yqsol(:knon) = qsol(ni(:knon))  
           ELSE  
              yqsol = 0.  
           END IF  
316    
317            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  
318    
319            DO k = 1, klev            DO k = 1, klev
320               DO j = 1, knon               DO j = 1, knon
# Line 370  contains Line 330  contains
330            END DO            END DO
331    
332            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
333            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
334                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
335                   coefh(:knon, :))
336            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
337               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
338               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 405  contains Line 366  contains
366                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
367               END DO               END DO
368               DO k = 1, klev               DO k = 1, klev
369                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
370                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
371               END DO               END DO
372               yzlev(1:knon, 1) = 0.               yzlev(1:knon, 1) = 0.
373               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
374                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
375               DO k = 2, klev               DO k = 2, klev
376                  yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))                  yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))
377               END DO               END DO
378               DO k = 1, klev + 1               DO k = 1, klev + 1
379                  DO j = 1, knon                  DO j = 1, knon
# Line 440  contains Line 401  contains
401            END IF            END IF
402    
403            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
404            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
405                 ypplay, ydelp, y_d_u, y_flux_u(:knon))                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
406            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
407                 ypplay, ydelp, y_d_v, y_flux_v(:knon))            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
408                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
409                   y_flux_v(:knon))
410    
411            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
412            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), ytsoil, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
413                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
414                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
415                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
416                   snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
417                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
418                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
419                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
420    
421            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
422            yrugm = 0.            yrugm = 0.
423            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
424               DO j = 1, knon               DO j = 1, knon
425                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &
426                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
427                         / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
428                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
429               END DO               END DO
430            END IF            END IF
431            DO j = 1, knon            DO j = 1, knon
432               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
433               y_dflux_q(j) = y_dflux_q(j)*ypct(j)               y_dflux_q(j) = y_dflux_q(j) * ypct(j)
              yu1(j) = yu1(j)*ypct(j)  
              yv1(j) = yv1(j)*ypct(j)  
434            END DO            END DO
435    
436            DO k = 1, klev            DO k = 1, klev
437               DO j = 1, knon               DO j = 1, knon
438                  i = ni(j)                  i = ni(j)
439                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
440                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
441                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
442                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
443                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
444                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
445               END DO               END DO
446            END DO            END DO
447    
448            DO j = 1, knon            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
449               i = ni(j)            flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
450               flux_t(i, nsrf) = y_flux_t(j)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
451               flux_q(i, nsrf) = y_flux_q(j)            flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
              flux_u(i, nsrf) = y_flux_u(j)  
              flux_v(i, nsrf) = y_flux_v(j)  
           END DO  
452    
453            evap(:, nsrf) = -flux_q(:, nsrf)            evap(:, nsrf) = -flux_q(:, nsrf)
454    
455            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
456            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
457            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
458            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
461               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
462               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
463               snow(i, nsrf) = ysnow(j)               fsnow(i, nsrf) = snow(j)
464               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
465               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
466               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
467               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
468                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
469                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
470               END IF               END IF
471               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
472               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 516  contains Line 475  contains
475               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
476               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
477               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
478               zu1(i) = zu1(i) + yu1(j)               zu1(i) = zu1(i) + u1lay(j) * ypct(j)
479               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + v1lay(j) * ypct(j)
480            END DO            END DO
481            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
482               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 529  contains Line 488  contains
488            END IF            END IF
489    
490            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
491            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  
492    
493            DO j = 1, knon            DO j = 1, knon
494               i = ni(j)               i = ni(j)
# Line 555  contains Line 509  contains
509               vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
510               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
511               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
512               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
513                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
514               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
515               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
516               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
517                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
518               END IF               END IF
519               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
520               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 568  contains Line 522  contains
522               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
523            END DO            END DO
524    
525            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
526                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
527                 yt10m, yq10m, yu10m, yustar)                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
528    
529            DO j = 1, knon            DO j = 1, knon
530               i = ni(j)               i = ni(j)
531               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
532               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
533    
534               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
535               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(uzon(j)**2 + vmer(j)**2)
536               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
537                      / sqrt(uzon(j)**2 + vmer(j)**2)
538            END DO            END DO
539    
540            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
# Line 607  contains Line 561  contains
561                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
562               END DO               END DO
563            END DO            END DO
564           else
565              fsnow(:, nsrf) = 0.
566         end IF if_knon         end IF if_knon
567      END DO loop_surface      END DO loop_surface
568    
569      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
570      rugos(:, is_oce) = rugmer      frugs(:, is_oce) = rugmer
571      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
572      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
573    
Legend:
Removed from v.207  
changed lines
  Added in v.225
  ViewVC Help
Powered by ViewVC 1.1.21