/[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 223 by guez, Fri Apr 28 13:22:36 2017 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 8  contains Line 8  contains
8         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &
12         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         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
# 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
27      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
28      USE conf_gcm_m, ONLY: prt_level, lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
29      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
30      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# 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):: julien ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
51      REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
# 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):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
66      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
# Line 74  contains Line 69  contains
69      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)      REAL, intent(out):: 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):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
# Line 94  contains Line 89  contains
89      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of 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 112  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        ! ce champ sur les quatre sous-surfaces du mod\`ele.
113    
114      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
115    
116      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117      ! (Comme les autres diagnostics on cumule dans physiq ce qui      ! composantes du vent \`a 10m sans spirale d'Ekman
118      ! permet de sortir les grandeurs par sous-surface)  
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)
# Line 136  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 153  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 ajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premi\`ere couche.  
       
155      REAL snow(klon), yqsurf(klon), yagesno(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
156        real yqsol(klon) ! column-density of water in soil, in kg m-2
157      real yqsol(klon)      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
158      ! column-density of water in soil, in kg m-2      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
   
     REAL yrain_f(klon)  
     ! liquid water mass flux (kg/m2/s), positive down  
   
     REAL ysnow_f(klon)  
     ! solid water mass flux (kg/m2/s), positive down  
   
159      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
160      REAL yfluxlat(klon)      REAL yfluxlat(klon)
161      REAL y_d_ts(klon)      REAL y_d_ts(klon)
# Line 180  contains Line 167  contains
167      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
168      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
169      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
170      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
171    
172      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
173    
174      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
175      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
176      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
177      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
178      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
179    
     REAL u1lay(klon), v1lay(klon)  
180      REAL delp(klon, klev)      REAL delp(klon, klev)
181      INTEGER i, k, nsrf      INTEGER i, k, nsrf
182    
# Line 200  contains Line 186  contains
186      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
187      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
188    
189      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation      REAL yt2m(klon), yq2m(klon), wind10m(klon)
190        REAL ustar(klon)
     REAL yt2m(klon), yq2m(klon), yu10m(klon)  
     REAL yustar(klon)  
191    
192      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
193      REAL ypblh(klon)      REAL ypblh(klon)
# Line 216  contains Line 200  contains
200      REAL ytrmb1(klon)      REAL ytrmb1(klon)
201      REAL ytrmb2(klon)      REAL ytrmb2(klon)
202      REAL ytrmb3(klon)      REAL ytrmb3(klon)
203      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
204      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
205      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
206    
207      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
208      REAL rugo1(klon)      REAL rugo1(klon)
209    
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
   
210      !------------------------------------------------------------      !------------------------------------------------------------
211    
212      ytherm = 0.      ytherm = 0.
213    
214      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
215         DO i = 1, klon         DO i = 1, klon
216            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
217         END DO         END DO
218      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  
219    
220      ! Initialization:      ! Initialization:
221      rugmer = 0.      rugmer = 0.
# Line 249  contains Line 223  contains
223      cdragm = 0.      cdragm = 0.
224      dflux_t = 0.      dflux_t = 0.
225      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
226      ypct = 0.      ypct = 0.
227      yqsurf = 0.      yqsurf = 0.
228      yrain_f = 0.      yrain_f = 0.
229      ysnow_f = 0.      ysnow_f = 0.
230      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
231      ypaprs = 0.      ypaprs = 0.
232      ypplay = 0.      ypplay = 0.
233      ydelp = 0.      ydelp = 0.
# Line 322  contains Line 292  contains
292               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
293               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
294               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              yu1(j) = u1lay(i)  
              yv1(j) = v1lay(i)  
295               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
296               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
297               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
298            END DO            END DO
299    
300            ! For continent, copy soil water content            ! For continent, copy soil water content
301            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              yqsol(:knon) = qsol(ni(:knon))  
           ELSE  
              yqsol = 0.  
           END IF  
302    
303            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
304    
# Line 355  contains Line 319  contains
319            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
320                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
321                 coefh(:knon, :))                 coefh(:knon, :))
322              
323            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
324               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
325               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 381  contains Line 346  contains
346               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
347                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
348                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
349                
350               DO k = 2, klev               DO k = 2, klev
351                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
352                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
353                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
354                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
355               END DO               END DO
356    
357               DO k = 1, klev               DO k = 1, klev
358                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
359                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
360               END DO               END DO
361               yzlev(1:knon, 1) = 0.  
362               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
363                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
364                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
365    
366               DO k = 2, klev               DO k = 2, klev
367                  yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))                  zlev(:knon, k) = 0.5 * (yzlay(:knon, k) + yzlay(:knon, k-1))
368               END DO               END DO
369    
370               DO k = 1, klev + 1               DO k = 1, klev + 1
371                  DO j = 1, knon                  DO j = 1, knon
372                     i = ni(j)                     i = ni(j)
# Line 404  contains Line 374  contains
374                  END DO                  END DO
375               END DO               END DO
376    
377               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
              IF (prt_level > 9) PRINT *, 'USTAR = ', yustar  
378    
379               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
380    
381               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
382                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &                  CALL vdif_kcay(knon, dtime, rg, zlev, yzlay, yu, yv, yteta, &
383                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &                       coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, ustar(:knon), &
384                       iflag_pbl)                       iflag_pbl)
385               ELSE               ELSE
386                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
387                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
388                         coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
389                         ykmn(:knon, :), ykmq(:knon, :), ustar(:knon), iflag_pbl)
390               END IF               END IF
391    
392               coefm(:knon, 2:) = ykmm(:knon, 2:klev)               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
# Line 423  contains Line 394  contains
394            END IF            END IF
395    
396            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
397            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
398                 ypplay, ydelp, y_d_u, y_flux_u(:knon))                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
399            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
400                 ypplay, ydelp, y_d_v, y_flux_v(:knon))            CALL clvent(knon, dtime, yu(:knon, 1), yv(:knon, 1), &
401                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
402                   y_flux_v(:knon))
403    
404            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
405            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
406                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
407                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &
408                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
409                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
410                 y_d_t, y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
411                 y_flux_q(:knon), y_dflux_t(:knon), y_dflux_q(:knon), &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
412                 y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
413    
414            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
415            yrugm = 0.            yrugm = 0.
416            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
417               DO j = 1, knon               DO j = 1, knon
418                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &
419                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
420                         / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
421                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
422               END DO               END DO
423            END IF            END IF
424            DO j = 1, knon            DO j = 1, knon
425               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
426               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)  
427            END DO            END DO
428    
429            DO k = 1, klev            DO k = 1, klev
430               DO j = 1, knon               DO j = 1, knon
431                  i = ni(j)                  i = ni(j)
432                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
433                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
434                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
435                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
436                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
437                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
438               END DO               END DO
439            END DO            END DO
440    
# Line 496  contains Line 468  contains
468               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
469               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
470               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)  
471            END DO            END DO
472            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
473               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 526  contains Line 496  contains
496    
497            DO j = 1, knon            DO j = 1, knon
498               i = ni(j)               i = ni(j)
499               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
500               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
501               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
502               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
503               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
504                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
505               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
506               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
507               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
# Line 543  contains Line 513  contains
513               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
514            END DO            END DO
515    
516            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
517                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
518                 yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
519    
520            DO j = 1, knon            DO j = 1, knon
521               i = ni(j)               i = ni(j)
522               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
523               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
524    
525               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
526               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
527               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
528                      / sqrt(u1(j)**2 + v1(j)**2)
529            END DO            END DO
530    
531            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
532                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
533                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
534    
Legend:
Removed from v.223  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21