/[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 222 by guez, Tue Apr 25 15:31:48 2017 UTC revision 239 by guez, Fri Nov 10 15:16:48 2017 UTC
# Line 6  contains Line 6  contains
6    
7    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, 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, fsnow, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, fder, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         frugs, 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
27      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
28      USE conf_gcm_m, ONLY: prt_level, lmt_pas      use coefkz2_m, only: coefkz2
29        USE conf_gcm_m, ONLY: lmt_pas
30      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
31      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
32      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
# Line 41  contains Line 37  contains
37      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
38      use time_phylmdz, only: itap      use time_phylmdz, only: itap
39      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
     use vdif_kcay_m, only: vdif_kcay  
40      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
41    
42      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
# 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)
     REAL, intent(in):: fder(:) ! (klon)  
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)
79      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
80      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
# Line 95  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 (flux turbulent de 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
106      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
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 137  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 154  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  
   
     REAL yfder(klon)  
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 179  contains Line 164  contains
164      REAL y_flux_t(klon), y_flux_q(klon)      REAL y_flux_t(klon), y_flux_q(klon)
165      REAL y_flux_u(klon), y_flux_v(klon)      REAL y_flux_u(klon), y_flux_v(klon)
166      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
167      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, 2:klev), coefm(klon, 2:klev)
168        real ycdragh(klon), ycdragm(klon)
169      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
170      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
171      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
   
172      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
173        REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
174      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
175      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL yq2(klon, klev + 1)
     REAL ykmq(klon, klev+1)  
     REAL yq2(klon, klev+1)  
     REAL q2diag(klon, klev+1)  
   
     REAL u1lay(klon), v1lay(klon)  
176      REAL delp(klon, klev)      REAL delp(klon, klev)
177      INTEGER i, k, nsrf      INTEGER i, k, nsrf
   
178      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
179    
180      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
181      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
182      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
183    
184      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation      REAL yt2m(klon), yq2m(klon), wind10m(klon)
185        REAL ustar(klon)
     REAL yt2m(klon), yq2m(klon), yu10m(klon)  
     REAL yustar(klon)  
186    
187      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
188      REAL ypblh(klon)      REAL ypblh(klon)
# Line 218  contains Line 195  contains
195      REAL ytrmb1(klon)      REAL ytrmb1(klon)
196      REAL ytrmb2(klon)      REAL ytrmb2(klon)
197      REAL ytrmb3(klon)      REAL ytrmb3(klon)
198      REAL uzon(klon), vmer(klon)      REAL u1(klon), v1(klon)
199      REAL tair1(klon), qair1(klon), tairsol(klon)      REAL tair1(klon), qair1(klon), tairsol(klon)
200      REAL psfce(klon), patm(klon)      REAL psfce(klon), patm(klon)
201    
202      REAL qairsol(klon), zgeo1(klon)      REAL qairsol(klon), zgeo1(klon)
203      REAL rugo1(klon)      REAL rugo1(klon)
204    
     ! utiliser un jeu de fonctions simples                
     LOGICAL zxli  
     PARAMETER (zxli=.FALSE.)  
   
205      !------------------------------------------------------------      !------------------------------------------------------------
206    
207      ytherm = 0.      ytherm = 0.
208    
209      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
210         DO i = 1, klon         DO i = 1, klon
211            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
212         END DO         END DO
213      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  
214    
215      ! Initialization:      ! Initialization:
216      rugmer = 0.      rugmer = 0.
# Line 251  contains Line 218  contains
218      cdragm = 0.      cdragm = 0.
219      dflux_t = 0.      dflux_t = 0.
220      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
221      ypct = 0.      ypct = 0.
222      yqsurf = 0.      yqsurf = 0.
223      yrain_f = 0.      yrain_f = 0.
224      ysnow_f = 0.      ysnow_f = 0.
225      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
226      ypaprs = 0.      ypaprs = 0.
227      ypplay = 0.      ypplay = 0.
228      ydelp = 0.      ydelp = 0.
# Line 322  contains Line 285  contains
285               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
286               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
287               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
              yfder(j) = fder(i)  
288               yrugos(j) = frugs(i, nsrf)               yrugos(j) = frugs(i, nsrf)
289               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
              yu1(j) = u1lay(i)  
              yv1(j) = v1lay(i)  
290               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
291               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
292               y_run_off_lic_0(j) = run_off_lic_0(i)               y_run_off_lic_0(j) = run_off_lic_0(i)
293            END DO            END DO
294    
295            ! For continent, copy soil water content            ! For continent, copy soil water content
296            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              yqsol(:knon) = qsol(ni(:knon))  
           ELSE  
              yqsol = 0.  
           END IF  
297    
298            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
299    
# Line 357  contains Line 313  contains
313            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
314            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
315                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
316                 coefh(:knon, :))                 coefh(:knon, :), ycdragm(:knon), ycdragh(:knon))
317    
318            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
319               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0(:knon, 2:), &
320               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))                    ycoefh0(:knon, 2:))
321               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               ycoefm0(:knon, 1) = 0.
322                 ycoefh0(:knon, 1) = 0.
323                 coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, 2:))
324                 coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, 2:))
325                 ycdragm(:knon) = max(ycdragm(:knon), 0.)
326                 ycdragh(:knon) = max(ycdragh(:knon), 0.)
327            END IF            END IF
328    
329            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
330            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
331               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
332               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
333            END IF            END IF
334    
335            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
336               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
337               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
338                    coefm(:knon, 1), ycoefm0, ycoefh0)                    ycdragm(:knon), ycoefh0(:knon, 2:))
339               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               ycoefm0(:knon, 2:) = ycoefh0(:knon, 2:)
340               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, 2:))
341                 coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, 2:))
342            END IF            END IF
343    
344            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
345               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
346               ! Fr\'ed\'eric Hourdin               ! Fr\'ed\'eric Hourdin
347               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
348                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
349                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
350    
351               DO k = 2, klev               DO k = 2, klev
352                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
353                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
354                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
355                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
356               END DO               END DO
357    
358               DO k = 1, klev               DO k = 1, klev
359                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
360                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
361               END DO               END DO
362               yzlev(1:knon, 1) = 0.  
363               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
364                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
365                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
366    
367               DO k = 2, klev               DO k = 2, klev
368                  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))
369               END DO               END DO
370    
371               DO k = 1, klev + 1               DO k = 1, klev + 1
372                  DO j = 1, knon                  DO j = 1, knon
373                     i = ni(j)                     i = ni(j)
# Line 407  contains Line 375  contains
375                  END DO                  END DO
376               END DO               END DO
377    
378               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))
379               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
380                      yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &
381               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                    ykmm(:knon, :), ykmn(:knon, :), ustar(:knon))
382                 coefm(:knon, :) = ykmm(:knon, 2:klev)
383               IF (iflag_pbl >= 11) THEN               coefh(:knon, :) = ykmn(:knon, 2:klev)
                 CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &  
                      yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &  
                      iflag_pbl)  
              ELSE  
                 CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &  
                      coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)  
              END IF  
   
              coefm(:knon, 2:) = ykmm(:knon, 2:klev)  
              coefh(:knon, 2:) = ykmn(:knon, 2:klev)  
384            END IF            END IF
385    
386            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
387            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
388                 ypplay, ydelp, y_d_u, y_flux_u(:knon))                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
389            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
390                 ypplay, ydelp, y_d_v, y_flux_v(:knon))            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
391                   ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
392                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
393                   y_flux_v(:knon))
394    
395            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
396            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
397                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
398                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), ycdragh(:knon), &
399                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
400                 ysnow_f, yfder(:knon), yfluxlat(:knon), pctsrf_new_sic, &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
401                 yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), yz0_new, &                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &
402                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &
403                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &
404                   y_run_off_lic_0)
405    
406            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
407            yrugm = 0.            yrugm = 0.
408            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
409               DO j = 1, knon               DO j = 1, knon
410                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2) &
411                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
412                         / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
413                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
414               END DO               END DO
415            END IF            END IF
416            DO j = 1, knon            DO j = 1, knon
417               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
418               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)  
419            END DO            END DO
420    
421              DO k = 2, klev
422                 DO j = 1, knon
423                    i = ni(j)
424                    coefh(j, k) = coefh(j, k) * ypct(j)
425                    coefm(j, k) = coefm(j, k) * ypct(j)
426                 END DO
427              END DO
428              DO j = 1, knon
429                 i = ni(j)
430                 ycdragh(j) = ycdragh(j) * ypct(j)
431                 ycdragm(j) = ycdragm(j) * ypct(j)
432              END DO
433            DO k = 1, klev            DO k = 1, klev
434               DO j = 1, knon               DO j = 1, knon
435                  i = ni(j)                  i = ni(j)
436                  coefh(j, k) = coefh(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
437                  coefm(j, k) = coefm(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
438                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
439                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
                 y_d_u(j, k) = y_d_u(j, k)*ypct(j)  
                 y_d_v(j, k) = y_d_v(j, k)*ypct(j)  
440               END DO               END DO
441            END DO            END DO
442    
# Line 495  contains Line 466  contains
466               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
467               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
468               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
469               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j)
470               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j)
471               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
472               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)  
473            END DO            END DO
474            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
475               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 521  contains Line 490  contains
490                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)                  d_q(i, k) = d_q(i, k) + y_d_q(j, k)
491                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)                  d_u(i, k) = d_u(i, k) + y_d_u(j, k)
492                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)                  d_v(i, k) = d_v(i, k) + y_d_v(j, k)
493                 END DO
494              END DO
495              
496              DO j = 1, knon
497                 i = ni(j)
498                 DO k = 2, klev
499                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
500               END DO               END DO
501            END DO            END DO
502    
503              DO j = 1, knon
504                 i = ni(j)
505                 ycoefh(i, 1) = ycoefh(i, 1) + ycdragh(j)
506              END DO
507    
508            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
509    
510            DO j = 1, knon            DO j = 1, knon
511               i = ni(j)               i = ni(j)
512               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
513               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
514               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
515               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
516               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
517                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
518               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
519               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
520               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
# Line 546  contains Line 526  contains
526               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
527            END DO            END DO
528    
529            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
530                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
531                 yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
532    
533            DO j = 1, knon            DO j = 1, knon
534               i = ni(j)               i = ni(j)
535               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
536               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
537    
538               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
539               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
540               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
541                      / sqrt(u1(j)**2 + v1(j)**2)
542            END DO            END DO
543    
544            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
545                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
546                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
547    
Legend:
Removed from v.222  
changed lines
  Added in v.239
  ViewVC Help
Powered by ViewVC 1.1.21