/[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 209 by guez, Wed Dec 7 17:37:21 2016 UTC revision 226 by guez, Mon Oct 16 13:04:05 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         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, t2m, q2m, &
12         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)         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
16      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
# Line 21  contains Line 21  contains
21      ! ne tient pas compte de la diff\'erentiation des sous-fractions      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! de sol.      ! de sol.
23    
     ! Pour pouvoir extraire les coefficients d'\'echanges et le vent  
     ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",  
     ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois  
     ! champs sur les quatre sous-surfaces du mod\`ele.  
   
24      use clqh_m, only: clqh      use clqh_m, only: clqh
25      use clvent_m, only: clvent      use clvent_m, only: clvent
26      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
# Line 50  contains Line 45  contains
45      ! tableau des pourcentages de surface de chaque maille      ! tableau des pourcentages de surface de chaque maille
46    
47      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
48      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg / kg)
49      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
50      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
51      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
52      REAL, INTENT(IN):: ftsol(klon, nbsrf) ! temp\'erature du sol (en K)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
53      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
54      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
55      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
# Line 62  contains Line 57  contains
57      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
58      ! soil temperature of surface fraction      ! soil temperature of surface fraction
59    
60      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: qsol(:) ! (klon)
61      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
62    
63      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
64      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
65      REAL, INTENT(inout):: snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
66      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
67      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
68      REAL, intent(inout):: falbe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
69        REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
     REAL fluxlat(klon, nbsrf)  
70    
71      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
72      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg / m2 / s), positive down
73    
74      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_f(klon)
75      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg / m2 / s), positive down
76    
77      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78      REAL, intent(in):: fder(klon)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
     REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)  
79      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
80      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
81    
# Line 93  contains Line 86  contains
86      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
87      ! changement pour "u" et "v"      ! changement pour "u" et "v"
88    
89      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour ftsol      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
90    
91      REAL, intent(out):: flux_t(klon, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
92      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
93      ! le bas) à la surface      ! le bas) à la surface
94    
95      REAL, intent(out):: flux_q(klon, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
96      ! flux de vapeur d'eau (kg/m2/s) à la surface      ! flux de vapeur d'eau (kg / m2 / s) à la surface
97    
98      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99      ! tension du vent à la surface, en Pa      ! tension du vent à la surface, en Pa
100    
101      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
102      real q2(klon, klev+1, nbsrf)      real q2(klon, klev + 1, nbsrf)
103    
104      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
105      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
# Line 114  contains Line 107  contains
107      ! IM "slab" ocean      ! IM "slab" ocean
108    
109      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
110      REAL, intent(out):: zu1(klon)      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
111      REAL zv1(klon)      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
112      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      ! ce champ sur les quatre sous-surfaces du mod\`ele.
113      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
114        REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
115      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm  
116      ! (Comme les autres diagnostics on cumule dans physiq ce qui      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117      ! permet de sortir les grandeurs par sous-surface)      ! composantes du vent \`a 10m sans spirale d'Ekman
118    
119        ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
120        ! Comme les autres diagnostics on cumule dans physiq ce qui permet
121        ! de sortir les grandeurs par sous-surface.
122      REAL pblh(klon, nbsrf) ! height of planetary boundary layer      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
123      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
124      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
125      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
126      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
127      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
128      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
129      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 139  contains Line 135  contains
135      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
136      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
137      ! 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
138      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg / m2 / s
139      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
140    
141      ! Local:      ! Local:
# Line 156  contains Line 152  contains
152      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
153      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
154      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  
155    
156      REAL yrain_f(klon)      REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
157      ! liquid water mass flux (kg/m2/s), positive down                                ! une sous-surface donnée
158        
159      REAL ysnow_f(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
160      ! solid water mass flux (kg/m2/s), positive down      real yqsol(klon) ! column-density of water in soil, in kg m-2
161        REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
162      REAL yfder(klon)      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
163      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
164      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
165      REAL y_d_ts(klon)      REAL y_d_ts(klon)
166      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
167      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
# Line 184  contains Line 171  contains
171      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
172      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
173      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
174      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
175    
176      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
177    
178      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
179      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
180      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
181      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
182      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
183    
     REAL u1lay(klon), v1lay(klon)  
184      REAL delp(klon, klev)      REAL delp(klon, klev)
185      INTEGER i, k, nsrf      INTEGER i, k, nsrf
186    
# Line 204  contains Line 190  contains
190      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
191      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
192    
     REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation  
   
193      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
194      REAL yustar(klon)      REAL yustar(klon)
195    
# Line 237  contains Line 221  contains
221    
222      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
223         DO i = 1, klon         DO i = 1, klon
224            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
225         END DO         END DO
226      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  
227    
228      ! Initialization:      ! Initialization:
229      rugmer = 0.      rugmer = 0.
# Line 253  contains Line 231  contains
231      cdragm = 0.      cdragm = 0.
232      dflux_t = 0.      dflux_t = 0.
233      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
234      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
235      yqsurf = 0.      yqsurf = 0.
236      yrain_f = 0.      yrain_f = 0.
237      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
238      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
239      ypaprs = 0.      ypaprs = 0.
240      ypplay = 0.      ypplay = 0.
241      ydelp = 0.      ydelp = 0.
# Line 277  contains Line 247  contains
247      y_dflux_q = 0.      y_dflux_q = 0.
248      yrugoro = 0.      yrugoro = 0.
249      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
250      flux_t = 0.      flux_t = 0.
251      flux_q = 0.      flux_q = 0.
252      flux_u = 0.      flux_u = 0.
253      flux_v = 0.      flux_v = 0.
254        fluxlat = 0.
255      d_t = 0.      d_t = 0.
256      d_q = 0.      d_q = 0.
257      d_u = 0.      d_u = 0.
# Line 299  contains Line 269  contains
269    
270      ! Tester si c'est le moment de lire le fichier:      ! Tester si c'est le moment de lire le fichier:
271      if (mod(itap - 1, lmt_pas) == 0) then      if (mod(itap - 1, lmt_pas) == 0) then
272         CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)         CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
273      endif      endif
274    
275      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
# Line 322  contains Line 292  contains
292               i = ni(j)               i = ni(j)
293               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
294               yts(j) = ftsol(i, nsrf)               yts(j) = ftsol(i, nsrf)
295               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
296               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
297               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
298               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
299               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
300               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
301               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              yrugos(j) = rugos(i, nsrf)  
302               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
303               yu1(j) = u1lay(i)               u1lay(j) = u(i, 1)
304               yv1(j) = v1lay(i)               v1lay(j) = v(i, 1)
305               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
306               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
307               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
308            END DO            END DO
309    
310            ! For continent, copy soil water content            ! For continent, copy soil water content
311            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              yqsol(:knon) = qsol(ni(:knon))  
           ELSE  
              yqsol = 0.  
           END IF  
312    
313            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
314    
# Line 361  contains Line 326  contains
326            END DO            END DO
327    
328            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
329            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, yu, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
330                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
331                   coefh(:knon, :))
332            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
333               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
334               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 396  contains Line 362  contains
362                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
363               END DO               END DO
364               DO k = 1, klev               DO k = 1, klev
365                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
366                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
367               END DO               END DO
368               yzlev(1:knon, 1) = 0.               yzlev(1:knon, 1) = 0.
369               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
370                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
371               DO k = 2, klev               DO k = 2, klev
372                  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))
373               END DO               END DO
374               DO k = 1, klev + 1               DO k = 1, klev + 1
375                  DO j = 1, knon                  DO j = 1, knon
# Line 431  contains Line 397  contains
397            END IF            END IF
398    
399            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
400            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
401                 ypplay, ydelp, y_d_u, y_flux_u(:knon))                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
402            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
403                 ypplay, ydelp, y_d_v, y_flux_v(:knon))            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
404                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
405                   y_flux_v(:knon))
406    
407            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
408            CALL clqh(dtime, jour, firstcal, nsrf, ni(:knon), ytsoil(:knon, :), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
409                 yqsol, rmu0, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
410                 yq, yts(:knon), ypaprs, ypplay, ydelp, yrads, yalb(:knon), &                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
411                 ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
412                   snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
413                 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), &
414                 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), &
415                 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)
416    
417            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
418            yrugm = 0.            yrugm = 0.
419            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
420               DO j = 1, knon               DO j = 1, knon
421                  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) &
422                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
423                         / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
424                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
425               END DO               END DO
426            END IF            END IF
427            DO j = 1, knon            DO j = 1, knon
428               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
429               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)  
430            END DO            END DO
431    
432            DO k = 1, klev            DO k = 1, klev
433               DO j = 1, knon               DO j = 1, knon
434                  i = ni(j)                  i = ni(j)
435                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
436                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
437                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
438                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
439                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
440                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
441               END DO               END DO
442            END DO            END DO
443    
444            DO j = 1, knon            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
445               i = ni(j)            flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
446               flux_t(i, nsrf) = y_flux_t(j)            flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
447               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  
448    
449            evap(:, nsrf) = -flux_q(:, nsrf)            evap(:, nsrf) = -flux_q(:, nsrf)
450    
451            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
452            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
453            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
454            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
455            DO j = 1, knon            DO j = 1, knon
456               i = ni(j)               i = ni(j)
457               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
458               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
459               snow(i, nsrf) = ysnow(j)               fsnow(i, nsrf) = snow(j)
460               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
461               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
462               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
463               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
464                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
465                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
466               END IF               END IF
467               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
468               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 507  contains Line 471  contains
471               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
472               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
473               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
              zu1(i) = zu1(i) + yu1(j)  
              zv1(i) = zv1(i) + yv1(j)  
474            END DO            END DO
475            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
476               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 541  contains Line 503  contains
503               vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
504               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
505               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
506               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
507                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
508               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
509               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
510               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
511                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
512               END IF               END IF
513               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
514               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 554  contains Line 516  contains
516               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
517            END DO            END DO
518    
519            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
520                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
521                 yt10m, yq10m, yu10m, yustar)                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
522    
523            DO j = 1, knon            DO j = 1, knon
524               i = ni(j)               i = ni(j)
525               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
526               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
527    
528               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
529               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(uzon(j)**2 + vmer(j)**2)
530               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
531                      / sqrt(uzon(j)**2 + vmer(j)**2)
532            END DO            END DO
533    
534            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
# Line 592  contains Line 555  contains
555                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
556               END DO               END DO
557            END DO            END DO
558           else
559              fsnow(:, nsrf) = 0.
560         end IF if_knon         end IF if_knon
561      END DO loop_surface      END DO loop_surface
562    
563      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
564      rugos(:, is_oce) = rugmer      frugs(:, is_oce) = rugmer
565      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
566      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
567    
Legend:
Removed from v.209  
changed lines
  Added in v.226
  ViewVC Help
Powered by ViewVC 1.1.21