/[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

trunk/phylmd/clmain.f revision 104 by guez, Thu Sep 4 10:05:52 2014 UTC trunk/Sources/phylmd/clmain.f revision 234 by guez, Tue Nov 7 12:20:42 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, frugs, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, t2m, q2m, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         u10m_srf, v10m_srf, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
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 19  contains Line 18  contains
18    
19      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
21      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! sol.      ! de sol.
   
     ! Pour pouvoir extraire les coefficients d'échanges et le vent  
     ! dans la première couche, trois champs ont été créés : "ycoefh",  
     ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois  
     ! champs sur les quatre sous-surfaces du modèle.  
23    
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      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
     USE dimens_m, ONLY: iim, jjm  
31      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
32      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
33      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
34      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      USE indicesol, ONLY: epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
35        USE interfoce_lim_m, ONLY: interfoce_lim
36      use stdlevvar_m, only: stdlevvar      use stdlevvar_m, only: stdlevvar
37      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
38        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)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
43    
44      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
45      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! 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):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
     REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)  
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
     REAL ftsoil(klon, nsoilmx, nbsrf)  
56    
57      REAL, INTENT(inout):: qsol(klon)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
58        ! soil temperature of surface fraction
59    
60        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 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 albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
69      REAL alblw(klon, nbsrf)      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 fder(klon)  
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
76    
77      REAL rugos(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78      ! rugos----input-R- longeur de rugosite (en m)      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
   
     LOGICAL, INTENT(IN):: debut  
79      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
80      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
81    
# Line 100  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 "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
90    
91        REAL, intent(out):: flux_t(klon, nbsrf)
92        ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
93        ! le bas) à la surface
94    
95      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_q(klon, nbsrf)
96      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de vapeur d'eau (kg / m2 / s) à la surface
97      !                    (orientation positive vers le bas)  
98      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99        ! tension du vent (flux turbulent de vent) à la surface, en Pa
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
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      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
116      ! physiq ce qui permet de sortir les grdeurs par sous surface)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117      REAL pblh(klon, nbsrf)      ! composantes du vent \`a 10m sans spirale d'Ekman
118      ! pblh------- HCL  
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
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 145  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    
     REAL flux_o(klon), flux_g(klon)  
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
   
141      ! Local:      ! Local:
142    
143      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
144      real ytslab(klon)  
145        ! la nouvelle repartition des surfaces sortie de l'interface
146        REAL, save:: pctsrf_new_oce(klon)
147        REAL, save:: pctsrf_new_sic(klon)
148    
149      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
150      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
151      REAL rugmer(klon)      REAL rugmer(klon)
   
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 yalblw(klon)      REAL snow(klon), yqsurf(klon), yagesno(klon)
156      REAL yu1(klon), yv1(klon)      real yqsol(klon) ! column-density of water in soil, in kg m-2
157      ! on rajoute en output yu1 et yv1 qui sont les vents dans      REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
158      ! la premiere couche      REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
     REAL ysnow(klon), yqsurf(klon), yagesno(klon)  
   
     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 ysollw(klon), ysolsw(klon)  
     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, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
165      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      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, 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      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
172        REAL yzlay(klon, klev), zlev(klon, klev + 1), yteta(klon, klev)
173      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
174      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmq(klon, klev + 1)
175      REAL ykmq(klon, klev+1)      REAL yq2(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 éventuelles      ! "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 extrapola.      REAL yt2m(klon), yq2m(klon), wind10m(klon)
185        REAL ustar(klon)
     REAL yt2m(klon), yq2m(klon), yu10m(klon)  
     REAL yustar(klon)  
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
186    
187      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
188      REAL ypblh(klon)      REAL ypblh(klon)
# Line 241  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 274  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.
     yalb = 0.  
     yalblw = 0.  
223      yrain_f = 0.      yrain_f = 0.
224      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ysolsw = 0.  
     ysollw = 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 298  contains Line 230  contains
230      yv = 0.      yv = 0.
231      yt = 0.      yt = 0.
232      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
233      y_dflux_t = 0.      y_dflux_t = 0.
234      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
235      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 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.
245      d_v = 0.      d_v = 0.
246      ycoefh = 0.      ycoefh = 0.
247    
248      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
249      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
250      ! (à affiner)      ! (\`a affiner)
251    
252      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
253        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
254      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
255      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
256    
257        ! Tester si c'est le moment de lire le fichier:
258        if (mod(itap - 1, lmt_pas) == 0) then
259           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
260        endif
261    
262      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
263    
264      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 335  contains Line 266  contains
266         ni = 0         ni = 0
267         knon = 0         knon = 0
268         DO i = 1, klon         DO i = 1, klon
269            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
270            ! "potentielles"            ! "potentielles"
271            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
272               knon = knon + 1               knon = knon + 1
# Line 347  contains Line 278  contains
278            DO j = 1, knon            DO j = 1, knon
279               i = ni(j)               i = ni(j)
280               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
281               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
282               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
283               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
284               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(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)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(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) = ysolsw(j) + ysollw(j)  
              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)
              yu10mx(j) = u10m(i, nsrf)  
              yu10my(j) = v10m(i, nsrf)  
              ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))  
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            DO k = 1, nsoilmx            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
              DO j = 1, knon  
                 i = ni(j)  
                 ytsoil(j, k) = ftsoil(i, k, nsrf)  
              END DO  
           END DO  
299    
300            DO k = 1, klev            DO k = 1, klev
301               DO j = 1, knon               DO j = 1, knon
# Line 399  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, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
315                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, 2:), &
316                   coefh(:knon, 2:), coefm(:knon, 1), coefh(:knon, 1))
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            END IF            END IF
# Line 416  contains Line 331  contains
331            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
332               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
333               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
334                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0(:knon, 2:), ycoefh0(:knon, 2:))
335               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
336               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
337            END IF            END IF
338    
339            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
340               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
341               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
342               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
343                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
344                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
345    
346               DO k = 2, klev               DO k = 2, klev
347                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
348                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
349                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
350                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
351               END DO               END DO
352    
353               DO k = 1, klev               DO k = 1, klev
354                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
355                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
356               END DO               END DO
357               yzlev(1:knon, 1) = 0.  
358               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
359                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
360                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
361    
362               DO k = 2, klev               DO k = 2, klev
363                  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))
364               END DO               END DO
365    
366               DO k = 1, klev + 1               DO k = 1, klev + 1
367                  DO j = 1, knon                  DO j = 1, knon
368                     i = ni(j)                     i = ni(j)
# Line 450  contains Line 370  contains
370                  END DO                  END DO
371               END DO               END DO
372    
373               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
374               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
375                      yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
376               ! iflag_pbl peut être utilisé comme longueur de mélange                    coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
377                      ykmn(:knon, :), ykmq(:knon, :), ustar(:knon))
              IF (iflag_pbl >= 11) THEN  
                 CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, 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  
   
378               coefm(:knon, 2:) = ykmm(:knon, 2:klev)               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
379               coefh(:knon, 2:) = ykmn(:knon, 2:klev)               coefh(:knon, 2:) = ykmn(:knon, 2:klev)
380            END IF            END IF
381    
382            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
383            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &                 coefm(:knon, 1), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
384                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
385            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
386                 ypplay, ydelp, y_d_v, y_flux_v)            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
387                   coefm(:knon, 1), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
388                   ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
389                   y_flux_v(:knon))
390    
391            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
392            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
393                 ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
394                 yu1, yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, :), yt, yq, &
395                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
396                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
397                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
398                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g)                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
399                   y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
400    
401            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
402            yrugm = 0.            yrugm = 0.
403            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
404               DO j = 1, knon               DO j = 1, knon
405                  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) &
406                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
407                         / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
408                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
409               END DO               END DO
410            END IF            END IF
411            DO j = 1, knon            DO j = 1, knon
412               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
413               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)  
414            END DO            END DO
415    
416            DO k = 1, klev            DO k = 1, klev
417               DO j = 1, knon               DO j = 1, knon
418                  i = ni(j)                  i = ni(j)
419                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
420                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
421                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
422                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
423                  flux_t(i, k, nsrf) = y_flux_t(j, k)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
424                  flux_q(i, k, nsrf) = y_flux_q(j, k)                  y_d_v(j, k) = y_d_v(j, k) * ypct(j)
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
                 y_d_u(j, k) = y_d_u(j, k)*ypct(j)  
                 y_d_v(j, k) = y_d_v(j, k)*ypct(j)  
425               END DO               END DO
426            END DO            END DO
427    
428            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
429              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
430              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
431              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
432    
433            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
434            alblw(:, nsrf) = 0.  
435            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
436              fsnow(:, nsrf) = 0.
437            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
438            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
439            DO j = 1, knon            DO j = 1, knon
440               i = ni(j)               i = ni(j)
441               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
442               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
443               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
444               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
445               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
446               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
447               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
448                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
449                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
450               END IF               END IF
451               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
452               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 543  contains Line 455  contains
455               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
456               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
457               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)  
458            END DO            END DO
459            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
460               qsol(ni(:knon)) = yqsol(:knon)               qsol(ni(:knon)) = yqsol(:knon)
# Line 554  contains Line 464  contains
464                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
465               END DO               END DO
466            END IF            END IF
467            !$$$ PB ajout pour soil  
468            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
469            DO k = 1, nsoilmx            ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
              DO j = 1, knon  
                 i = ni(j)  
                 ftsoil(i, k, nsrf) = ytsoil(j, k)  
              END DO  
           END DO  
470    
471            DO j = 1, knon            DO j = 1, knon
472               i = ni(j)               i = ni(j)
# Line 578  contains Line 483  contains
483    
484            DO j = 1, knon            DO j = 1, knon
485               i = ni(j)               i = ni(j)
486               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
487               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
488               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
489               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
490               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
491                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
492               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
493               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
494               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
495                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
496               END IF               END IF
497               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
498               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 595  contains Line 500  contains
500               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
501            END DO            END DO
502    
503            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
504                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
505                 yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
506    
507            DO j = 1, knon            DO j = 1, knon
508               i = ni(j)               i = ni(j)
509               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
510               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
511    
512               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
513               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
514               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
515                      / sqrt(u1(j)**2 + v1(j)**2)
516            END DO            END DO
517    
518            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
519                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
520                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
521    
522            DO j = 1, knon            DO j = 1, knon
523               i = ni(j)               i = ni(j)
# Line 634  contains Line 539  contains
539                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
540               END DO               END DO
541            END DO            END DO
542            !IM "slab" ocean         else
543            IF (nsrf == is_oce) THEN            fsnow(:, nsrf) = 0.
              DO j = 1, knon  
                 ! on projette sur la grille globale  
                 i = ni(j)  
                 IF (pctsrf_new(i, is_oce)>epsfra) THEN  
                    flux_o(i) = y_flux_o(j)  
                 ELSE  
                    flux_o(i) = 0.  
                 END IF  
              END DO  
           END IF  
   
           IF (nsrf == is_sic) THEN  
              DO j = 1, knon  
                 i = ni(j)  
                 ! On pondère lorsque l'on fait le bilan au sol :  
                 IF (pctsrf_new(i, is_sic)>epsfra) THEN  
                    flux_g(i) = y_flux_g(j)  
                 ELSE  
                    flux_g(i) = 0.  
                 END IF  
              END DO  
   
           END IF  
544         end IF if_knon         end IF if_knon
545      END DO loop_surface      END DO loop_surface
546    
547      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
548        frugs(:, is_oce) = rugmer
549        pctsrf(:, is_oce) = pctsrf_new_oce
550        pctsrf(:, is_sic) = pctsrf_new_sic
551    
552      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
553    
554    END SUBROUTINE clmain    END SUBROUTINE clmain
555    
Legend:
Removed from v.104  
changed lines
  Added in v.234
  ViewVC Help
Powered by ViewVC 1.1.21