/[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 208 by guez, Wed Dec 7 16:44:53 2016 UTC revision 241 by guez, Mon Nov 13 11:51:04 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, 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):: 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
   
     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)  
76    
77        REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78        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)
81    
# Line 96  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 (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      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 142  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 159  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)
155      REAL yu1(klon), yv1(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
156      ! on rajoute en output yu1 et yv1 qui sont les vents dans      real yqsol(klon) ! column-density of water in soil, in kg m-2
157      ! la premiere couche      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
158      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
   
     real yqsol(klon)  
     ! column-density of water in soil, in kg m-2  
   
     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)
162      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
163      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
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, 2:klev), ycoefh0(klon, 2:klev)
173      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
174        REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
175      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yq2(klon, klev + 1)
     REAL ykmm(klon, klev+1), ykmn(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 223  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 256  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.
     yts = 0.  
     ysnow = 0.  
222      yqsurf = 0.      yqsurf = 0.
223      yrain_f = 0.      yrain_f = 0.
224      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
225      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
226      ypaprs = 0.      ypaprs = 0.
227      ypplay = 0.      ypplay = 0.
228      ydelp = 0.      ydelp = 0.
# Line 280  contains Line 234  contains
234      y_dflux_q = 0.      y_dflux_q = 0.
235      yrugoro = 0.      yrugoro = 0.
236      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
237      flux_t = 0.      flux_t = 0.
238      flux_q = 0.      flux_q = 0.
239      flux_u = 0.      flux_u = 0.
240      flux_v = 0.      flux_v = 0.
241        fluxlat = 0.
242      d_t = 0.      d_t = 0.
243      d_q = 0.      d_q = 0.
244      d_u = 0.      d_u = 0.
# Line 302  contains Line 256  contains
256    
257      ! Tester si c'est le moment de lire le fichier:      ! Tester si c'est le moment de lire le fichier:
258      if (mod(itap - 1, lmt_pas) == 0) then      if (mod(itap - 1, lmt_pas) == 0) then
259         CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)         CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
260      endif      endif
261    
262      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
# Line 325  contains Line 279  contains
279               i = ni(j)               i = ni(j)
280               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
281               yts(j) = ftsol(i, nsrf)               yts(j) = ftsol(i, nsrf)
282               ysnow(j) = snow(i, nsrf)               snow(j) = fsnow(i, nsrf)
283               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
284               yalb(j) = falbe(i, nsrf)               yalb(j) = falbe(i, nsrf)
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)
288               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              yrugos(j) = rugos(i, nsrf)  
289               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
290               yu1(j) = u1lay(i)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
291               yv1(j) = v1lay(i)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
              yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)  
              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 364  contains Line 311  contains
311            END DO            END DO
312    
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, yrugos, yu, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
315                 yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
316                   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, :), &
320                      ycoefh0(:knon, :))
321               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
322               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
323                 ycdragm(:knon) = max(ycdragm(:knon), 0.)
324                 ycdragh(:knon) = max(ycdragh(:knon), 0.)
325            END IF            END IF
326    
327            ! on met un seuil pour coefm et coefh            ! on met un seuil pour ycdragm et ycdragh
328            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
329               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               ycdragm(:knon) = min(ycdragm(:knon), cdmmax)
330               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               ycdragh(:knon) = min(ycdragh(:knon), cdhmax)
331            END IF            END IF
332    
333            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
334               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
335               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
336                    coefm(:knon, 1), ycoefm0, ycoefh0)                    ycdragm(:knon), ycoefh0(:knon, :))
337                 ycoefm0(:knon, :) = ycoefh0(:knon, :)
338               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
339               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
340            END IF            END IF
341    
342            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
343               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
344               ! Fr\'ed\'eric Hourdin               ! Fr\'ed\'eric Hourdin
345               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
346                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
347                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
348    
349               DO k = 2, klev               DO k = 2, klev
350                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
351                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
352                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
353                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
354               END DO               END DO
355    
356               DO k = 1, klev               DO k = 1, klev
357                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
358                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
359               END DO               END DO
360               yzlev(1:knon, 1) = 0.  
361               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
362                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
363                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
364    
365               DO k = 2, klev               DO k = 2, klev
366                  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))
367               END DO               END DO
368    
369               DO k = 1, klev + 1               DO k = 1, klev + 1
370                  DO j = 1, knon                  DO j = 1, knon
371                     i = ni(j)                     i = ni(j)
# Line 415  contains Line 373  contains
373                  END DO                  END DO
374               END DO               END DO
375    
376               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), ycdragm(:knon))
377               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
378                      yu(:knon, :), yv(:knon, :), yteta(:knon, :), yq2(:knon, :), &
379               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange                    ykmm(:knon, :), ykmn(:knon, :), ustar(:knon))
380                 coefm(:knon, :) = ykmm(:knon, 2:klev)
381               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)  
382            END IF            END IF
383    
384            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
385            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &                 ycdragm(:knon), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
386                 ypplay, ydelp, y_d_u, y_flux_u(:knon))                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
387            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
388                 ypplay, ydelp, y_d_v, y_flux_v(:knon))            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, :), &
389                   ycdragm(:knon), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
390                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
391                   y_flux_v(:knon))
392    
393            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
394            CALL clqh(dtime, jour, firstcal, rlat, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
395                 ytsoil(:knon, :), yqsol, rmu0, yrugos, yrugoro, yu1, yv1, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
396                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), ycdragh(:knon), &
397                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
398                 yfluxlat, pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
399                   yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &
400                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &
401                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &
402                   y_run_off_lic_0)
403    
404            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
405            yrugm = 0.            yrugm = 0.
406            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
407               DO j = 1, knon               DO j = 1, knon
408                  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) &
409                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
410                         / sqrt(ycdragm(j) * (yu(j, 1)**2 + yv(j, 1)**2))
411                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
412               END DO               END DO
413            END IF            END IF
414            DO j = 1, knon            DO j = 1, knon
415               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
416               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)  
417            END DO            END DO
418    
419            DO k = 1, klev            DO k = 2, klev
420               DO j = 1, knon               DO j = 1, knon
421                  i = ni(j)                  i = ni(j)
422                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
423                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
                 y_d_t(j, k) = y_d_t(j, k)*ypct(j)  
                 y_d_q(j, k) = y_d_q(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)  
424               END DO               END DO
425            END DO            END DO
   
426            DO j = 1, knon            DO j = 1, knon
427               i = ni(j)               i = ni(j)
428               flux_t(i, nsrf) = y_flux_t(j)               ycdragh(j) = ycdragh(j) * ypct(j)
429               flux_q(i, nsrf) = y_flux_q(j)               ycdragm(j) = ycdragm(j) * ypct(j)
              flux_u(i, nsrf) = y_flux_u(j)  
              flux_v(i, nsrf) = y_flux_v(j)  
430            END DO            END DO
431              DO k = 1, klev
432                 DO j = 1, knon
433                    i = ni(j)
434                    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)
436                    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)
438                 END DO
439              END DO
440    
441              flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
442              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
443              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
444              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
445    
446            evap(:, nsrf) = -flux_q(:, nsrf)            evap(:, nsrf) = -flux_q(:, nsrf)
447    
448            falbe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
449            snow(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
450            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
451            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
452            DO j = 1, knon            DO j = 1, knon
453               i = ni(j)               i = ni(j)
454               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
455               falbe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
456               snow(i, nsrf) = ysnow(j)               fsnow(i, nsrf) = snow(j)
457               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
458               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
459               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
460               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
461                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
462                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
463               END IF               END IF
464               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
465               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
466               ffonte(i, nsrf) = y_ffonte(j)               ffonte(i, nsrf) = y_ffonte(j)
467               cdragh(i) = cdragh(i) + coefh(j, 1)               cdragh(i) = cdragh(i) + ycdragh(j)
468               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + ycdragm(j)
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 532  contains Line 488  contains
488                  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)
489                  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)
490                  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)
                 ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)  
491               END DO               END DO
492            END DO            END DO
493              
494              ycoefh(ni(:knon), 2:) = ycoefh(ni(:knon), 2:) + coefh(:knon, :)
495              ycoefh(ni(:knon), 1) = ycoefh(ni(:knon), 1) + ycdragh(:knon)
496    
497            ! diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
498    
499            DO j = 1, knon            DO j = 1, knon
500               i = ni(j)               i = ni(j)
501               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
502               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
503               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
504               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
505               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
506                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
507               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
508               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
509               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
510                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
511               END IF               END IF
512               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
513               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 557  contains Line 515  contains
515               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
516            END DO            END DO
517    
518            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
519                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
520                 yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
521    
522            DO j = 1, knon            DO j = 1, knon
523               i = ni(j)               i = ni(j)
524               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
525               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
526    
527               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
528               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
529               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
530                      / sqrt(u1(j)**2 + v1(j)**2)
531            END DO            END DO
532    
533            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
534                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
535                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
536    
# Line 595  contains Line 554  contains
554                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
555               END DO               END DO
556            END DO            END DO
557           else
558              fsnow(:, nsrf) = 0.
559         end IF if_knon         end IF if_knon
560      END DO loop_surface      END DO loop_surface
561    
562      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
563      rugos(:, is_oce) = rugmer      frugs(:, is_oce) = rugmer
564      pctsrf(:, is_oce) = pctsrf_new_oce      pctsrf(:, is_oce) = pctsrf_new_oce
565      pctsrf(:, is_sic) = pctsrf_new_sic      pctsrf(:, is_sic) = pctsrf_new_sic
566    
Legend:
Removed from v.208  
changed lines
  Added in v.241
  ViewVC Help
Powered by ViewVC 1.1.21