/[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/libf/phylmd/clmain.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/Sources/phylmd/clmain.f revision 222 by guez, Tue Apr 25 15:31:48 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, date0, pctsrf, pctsrf_new, t, q, u, v, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, ts, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, fder, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         frugs, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         rain_fall, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        dflux_t, dflux_q, zcoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &  
        capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &  
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)  
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
17      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
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.
23    
24      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! dans la première couche, trois champs ont été créés : "zcoefh",      ! dans la premi\`ere couche, trois champs ont \'et\'e cr\'e\'es : "ycoefh",
26      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
28    
     use calendar, ONLY: ymds2ju  
29      use clqh_m, only: clqh      use clqh_m, only: clqh
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
     USE histbeg_totreg_m, ONLY: histbeg_totreg  
     USE histdef_m, ONLY: histdef  
     USE histend_m, ONLY: histend  
     USE histsync_m, ONLY: histsync  
     use histwrite_m, only: histwrite  
38      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
39        USE interfoce_lim_m, ONLY: interfoce_lim
40        use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42      USE temps, ONLY: annee_ref, itau_phy      use time_phylmdz, only: itap
43      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
44      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
45      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
46    
     ! Arguments:  
   
47      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(IN):: date0 ! jour initial  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: julien ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57        REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
58        REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59        REAL, INTENT(IN):: ksta, ksta_ter
60        LOGICAL, INTENT(IN):: ok_kzmin
61    
62        REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63        ! soil temperature of surface fraction
64    
65        REAL, INTENT(inout):: qsol(klon)
66        ! column-density of water in soil, in kg m-2
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
71      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL qsurf(klon, nbsrf)
72      REAL cufi(klon), cvfi(klon)      REAL evap(klon, nbsrf)
73      ! cufi-----input-R- resolution des mailles en x (m)      REAL, intent(inout):: falbe(klon, nbsrf)
74      ! cvfi-----input-R- resolution des mailles en y (m)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
75    
76        REAL, intent(in):: rain_fall(klon)
77        ! liquid water mass flux (kg/m2/s), positive down
78    
79        REAL, intent(in):: snow_f(klon)
80        ! solid water mass flux (kg/m2/s), positive down
81    
82        REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83        REAL, intent(in):: fder(:) ! (klon)
84        REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
85        real agesno(klon, nbsrf)
86        REAL, INTENT(IN):: rugoro(klon)
87    
88      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
89      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
90      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
# Line 83  contains Line 92  contains
92      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
93      ! changement pour "u" et "v"      ! changement pour "u" et "v"
94    
95      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
96      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)  
97      !                    (orientation positive vers le bas)      REAL, intent(out):: flux_t(klon, nbsrf)
98      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
99      REAL dflux_t(klon), dflux_q(klon)      ! le bas) à la surface
100    
101        REAL, intent(out):: flux_q(klon, nbsrf)
102        ! flux de vapeur d'eau (kg/m2/s) à la surface
103    
104        REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
105        ! tension du vent à la surface, en Pa
106    
107        REAL, INTENT(out):: cdragh(klon), cdragm(klon)
108        real q2(klon, klev+1, nbsrf)
109    
110        REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
111      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
112      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
113      !IM "slab" ocean      ! IM "slab" ocean
114      REAL flux_o(klon), flux_g(klon)  
115      !IM "slab" ocean      REAL, intent(out):: ycoefh(klon, klev)
116      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      REAL, intent(out):: zu1(klon)
117      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      REAL zv1(klon)
118      REAL y_flux_o(klon), y_flux_g(klon)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
119      REAL tslab(klon), ytslab(klon)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
120      ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
121      ! uniqmnt pour slab      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
122      REAL seaice(klon), y_seaice(klon)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
123      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! permet de sortir les grandeurs par sous-surface)
124      REAL y_fqcalving(klon), y_ffonte(klon)      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125        REAL capcl(klon, nbsrf)
126        REAL oliqcl(klon, nbsrf)
127        REAL cteicl(klon, nbsrf)
128        REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
129        REAL therm(klon, nbsrf)
130        REAL trmb1(klon, nbsrf)
131        ! trmb1-------deep_cape
132        REAL trmb2(klon, nbsrf)
133        ! trmb2--------inhibition
134        REAL trmb3(klon, nbsrf)
135        ! trmb3-------Point Omega
136        REAL plcl(klon, nbsrf)
137      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
138      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
139      ! 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
140      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
141      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon)
142    
143      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      ! Local:
     ! 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  
     REAL rugmer(klon), agesno(klon, nbsrf)  
     REAL, INTENT(IN):: rugoro(klon)  
     REAL, INTENT(out):: cdragh(klon), cdragm(klon)  
     ! taux CO2 atmosphere                      
     REAL co2_ppm  
     LOGICAL, INTENT(IN):: debut  
     LOGICAL, INTENT(IN):: lafin  
     LOGICAL ok_veget  
     CHARACTER(len=*), INTENT(IN):: ocean  
     INTEGER npas, nexca  
   
     REAL ts(klon, nbsrf)  
     ! ts-------input-R- temperature du sol (en Kelvin)  
     REAL d_ts(klon, nbsrf)  
     ! d_ts-----output-R- le changement pour "ts"  
     REAL snow(klon, nbsrf)  
     REAL qsurf(klon, nbsrf)  
     REAL evap(klon, nbsrf)  
     REAL albe(klon, nbsrf)  
     REAL alblw(klon, nbsrf)  
144    
145      REAL fluxlat(klon, nbsrf)      LOGICAL:: firstcal = .true.
146    
147      REAL, intent(in):: rain_fall(klon), snow_f(klon)      ! la nouvelle repartition des surfaces sortie de l'interface
148      REAL fder(klon)      REAL, save:: pctsrf_new_oce(klon)
149        REAL, save:: pctsrf_new_sic(klon)
150    
151      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
152      REAL rugos(klon, nbsrf)      real y_run_off_lic_0(klon)
153      ! rugos----input-R- longeur de rugosite (en m)      REAL rugmer(klon)
154        REAL ytsoil(klon, nsoilmx)
155        REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156        REAL yalb(klon)
157    
158      REAL zcoefh(klon, klev)      REAL yu1(klon), yv1(klon)
159      REAL zu1(klon)      ! On ajoute en output yu1 et yv1 qui sont les vents dans
160      REAL zv1(klon)      ! la premi\`ere couche.
161        
162        REAL snow(klon), yqsurf(klon), yagesno(klon)
163    
164      !$$$ PB ajout pour soil      real yqsol(klon)
165      LOGICAL, INTENT(IN):: soil_model      ! column-density of water in soil, in kg m-2
     !IM ajout seuils cdrm, cdrh  
     REAL cdmmax, cdhmax  
166    
167      REAL ksta, ksta_ter      REAL yrain_f(klon)
168      LOGICAL ok_kzmin      ! liquid water mass flux (kg/m2/s), positive down
169    
170      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL ysnow_f(klon)
171      REAL ytsoil(klon, nsoilmx)      ! solid water mass flux (kg/m2/s), positive down
     REAL qsol(klon)  
172    
173      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yfder(klon)
     REAL yalb(klon)  
     REAL yalblw(klon)  
     REAL yu1(klon), yv1(klon)  
     ! on rajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premiere couche  
     REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)  
     REAL yrain_f(klon), ysnow_f(klon)  
     REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)  
     REAL yfder(klon), ytaux(klon), ytauy(klon)  
174      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
175      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
176      REAL y_d_ts(klon)      REAL y_d_ts(klon)
177      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
178      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
179      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
180      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
181      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
182      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
183      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
184      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
185      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
186    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
187      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
188    
189      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
190      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
191      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
192      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1)
193      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
194    
195      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
# Line 199  contains Line 199  contains
199      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
200    
201      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
202      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
203      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
204    
205      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
   
     ! maf pour sorties IOISPL en cas de debugagage  
   
     CHARACTER(80) cldebug  
     SAVE cldebug  
     CHARACTER(8) cl_surf(nbsrf)  
     SAVE cl_surf  
     INTEGER nhoridbg, nidbg  
     SAVE nhoridbg, nidbg  
     INTEGER ndexbg(iim*(jjm+1))  
     REAL zx_lon(iim, jjm+1), zx_lat(iim, jjm+1), zjulian  
     REAL tabindx(klon)  
     REAL debugtab(iim, jjm+1)  
     LOGICAL first_appel  
     SAVE first_appel  
     DATA first_appel/ .TRUE./  
     LOGICAL:: debugindex = .FALSE.  
     INTEGER idayref  
     REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
     REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
206    
207      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
208      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
209    
210      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
     !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
     ! physiq ce qui permet de sortir les grdeurs par sous surface)  
     REAL pblh(klon, nbsrf)  
     ! pblh------- HCL  
     REAL plcl(klon, nbsrf)  
     REAL capcl(klon, nbsrf)  
     REAL oliqcl(klon, nbsrf)  
     REAL cteicl(klon, nbsrf)  
     REAL pblt(klon, nbsrf)  
     ! pblT------- T au nveau HCL  
     REAL therm(klon, nbsrf)  
     REAL trmb1(klon, nbsrf)  
     ! trmb1-------deep_cape  
     REAL trmb2(klon, nbsrf)  
     ! trmb2--------inhibition  
     REAL trmb3(klon, nbsrf)  
     ! trmb3-------Point Omega  
211      REAL ypblh(klon)      REAL ypblh(klon)
212      REAL ylcl(klon)      REAL ylcl(klon)
213      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 271  contains Line 229  contains
229      LOGICAL zxli      LOGICAL zxli
230      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
231    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
232      !------------------------------------------------------------      !------------------------------------------------------------
233    
234      ytherm = 0.      ytherm = 0.
235    
     IF (debugindex .AND. first_appel) THEN  
        first_appel = .FALSE.  
   
        ! initialisation sorties netcdf  
   
        idayref = day_ini  
        CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)  
        DO i = 1, iim  
           zx_lon(i, 1) = rlon(i+1)  
           zx_lon(i, jjm+1) = rlon(i+1)  
        END DO  
        CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlat, zx_lat)  
        cldebug = 'sous_index'  
        CALL histbeg_totreg(cldebug, zx_lon(:, 1), zx_lat(1, :), 1, &  
             iim, 1, jjm+1, itau_phy, zjulian, dtime, nhoridbg, nidbg)  
        ! no vertical axis  
        cl_surf(1) = 'ter'  
        cl_surf(2) = 'lic'  
        cl_surf(3) = 'oce'  
        cl_surf(4) = 'sic'  
        DO nsrf = 1, nbsrf  
           CALL histdef(nidbg, cl_surf(nsrf), cl_surf(nsrf), '-', iim, jjm+1, &  
                nhoridbg, 1, 1, 1, -99, 'inst', dtime, dtime)  
        END DO  
        CALL histend(nidbg)  
        CALL histsync(nidbg)  
     END IF  
   
236      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
237         DO i = 1, klon         DO i = 1, klon
238            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 331  contains Line 254  contains
254      zu1 = 0.      zu1 = 0.
255      zv1 = 0.      zv1 = 0.
256      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
257      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
258      yrain_f = 0.      yrain_f = 0.
259      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
260      yrugos = 0.      yrugos = 0.
261      yu1 = 0.      yu1 = 0.
262      yv1 = 0.      yv1 = 0.
     yrads = 0.  
263      ypaprs = 0.      ypaprs = 0.
264      ypplay = 0.      ypplay = 0.
265      ydelp = 0.      ydelp = 0.
# Line 355  contains Line 267  contains
267      yv = 0.      yv = 0.
268      yt = 0.      yt = 0.
269      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
270      y_dflux_t = 0.      y_dflux_t = 0.
271      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
272      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
273      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     yfluxlat = 0.  
274      flux_t = 0.      flux_t = 0.
275      flux_q = 0.      flux_q = 0.
276      flux_u = 0.      flux_u = 0.
277      flux_v = 0.      flux_v = 0.
278        fluxlat = 0.
279      d_t = 0.      d_t = 0.
280      d_q = 0.      d_q = 0.
281      d_u = 0.      d_u = 0.
282      d_v = 0.      d_v = 0.
283      zcoefh = 0.      ycoefh = 0.
284    
285      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
286        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
287      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! (\`a affiner)
     ! peut avoir potentiellement de la glace sur tout le domaine océanique  
     ! (à affiner)  
288    
289      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
290        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
291      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
292      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
293    
294        ! Tester si c'est le moment de lire le fichier:
295        if (mod(itap - 1, lmt_pas) == 0) then
296           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
297        endif
298    
299        ! Boucler sur toutes les sous-fractions du sol:
300    
301      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
302         ! Chercher les indices :         ! Chercher les indices :
303         ni = 0         ni = 0
304         knon = 0         knon = 0
305         DO i = 1, klon         DO i = 1, klon
306            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
307            ! "potentielles"            ! "potentielles"
308            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
309               knon = knon + 1               knon = knon + 1
# Line 404  contains Line 311  contains
311            END IF            END IF
312         END DO         END DO
313    
        ! variables pour avoir une sortie IOIPSL des INDEX  
        IF (debugindex) THEN  
           tabindx = 0.  
           DO i = 1, knon  
              tabindx(i) = real(i)  
           END DO  
           debugtab = 0.  
           ndexbg = 0  
           CALL gath2cpl(tabindx, debugtab, klon, knon, iim, jjm, ni)  
           CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)  
        END IF  
   
314         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
315            DO j = 1, knon            DO j = 1, knon
316               i = ni(j)               i = ni(j)
317               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
318               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
319               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
320               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
321               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
322               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
323               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
324               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
325               yfder(j) = fder(i)               yfder(j) = fder(i)
326               ytaux(j) = flux_u(i, 1, nsrf)               yrugos(j) = frugs(i, nsrf)
              ytauy(j) = flux_v(i, 1, nsrf)  
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
              ysollwdown(j) = sollwdown(i)  
              yrugos(j) = rugos(i, nsrf)  
327               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
328               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
329               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
330               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
331               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
332               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))  
333            END DO            END DO
334    
335            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
336            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
337               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
338            ELSE            ELSE
339               yqsol = 0.               yqsol = 0.
340            END IF            END IF
341    
342            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  
343    
344            DO k = 1, klev            DO k = 1, klev
345               DO j = 1, knon               DO j = 1, knon
# Line 478  contains Line 355  contains
355            END DO            END DO
356    
357            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
358            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
359                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
360                   coefh(:knon, :))
361            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
362               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
363               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
364               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
365            END IF            END IF
366    
367            ! on seuille coefm et coefh            ! on met un seuil pour coefm et coefh
368            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
369               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
370               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
# Line 495  contains Line 373  contains
373            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
374               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
375               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
376                    coefm(:, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
377               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
378               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
379             END IF            END IF
380    
381            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
382               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
383               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
384               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
385                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
386                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 530  contains Line 408  contains
408               END DO               END DO
409    
410               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
411                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
412    
413               IF (prt_level > 9) THEN               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
                 PRINT *, 'USTAR = ', yustar  
              END IF  
   
              ! iflag_pbl peut être utilisé comme longueur de mélange  
414    
415               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
416                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
417                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
418                       yustar, iflag_pbl)                       iflag_pbl)
419               ELSE               ELSE
420                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
421                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 551  contains Line 426  contains
426            END IF            END IF
427    
428            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
429            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yu, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
430                 ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
431            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yv, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
432                 ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
   
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
433    
434            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
435            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
436                 cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
437                 yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
438                 yrugoro, yu1, yv1, coefh, yt, yq, yts, ypaprs, ypplay, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
439                 ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                 ysnow_f, yfder(:knon), yfluxlat(:knon), pctsrf_new_sic, &
440                 yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw, &                 yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), yz0_new, &
441                 yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
442                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, &  
                ytslab, y_seaice)  
443    
444            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
445            yrugm = 0.            yrugm = 0.
# Line 595  contains Line 464  contains
464                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
465                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
466                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
467                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
468                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
469               END DO               END DO
470            END DO            END DO
471    
472            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
473              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
474              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
475              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
476    
477            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
478            alblw(:, nsrf) = 0.  
479            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
480              fsnow(:, nsrf) = 0.
481            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
482            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
483            DO j = 1, knon            DO j = 1, knon
484               i = ni(j)               i = ni(j)
485               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
486               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
487               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
488               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
489               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
490               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
491               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
492                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
493                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
494               END IF               END IF
495               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
496               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 636  contains Line 503  contains
503               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
504            END DO            END DO
505            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
506               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
507                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
508               DO j = 1, knon               DO j = 1, knon
509                  i = ni(j)                  i = ni(j)
510                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
511               END DO               END DO
512            END IF            END IF
513            !$$$ PB ajout pour soil  
514            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
515            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  
516    
517            DO j = 1, knon            DO j = 1, knon
518               i = ni(j)               i = ni(j)
# Line 663  contains Line 521  contains
521                  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)
522                  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)
523                  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)
524                  zcoefh(i, k) = zcoefh(i, k) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
525               END DO               END DO
526            END DO            END DO
527    
528            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
529    
530            DO j = 1, knon            DO j = 1, knon
531               i = ni(j)               i = ni(j)
# Line 680  contains Line 538  contains
538               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
539               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
540               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
541                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
542               END IF               END IF
543               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
544               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 700  contains Line 558  contains
558               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
559               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
560               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
   
561            END DO            END DO
562    
563            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
564                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
565                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
566    
567            DO j = 1, knon            DO j = 1, knon
568               i = ni(j)               i = ni(j)
# Line 727  contains Line 584  contains
584                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
585               END DO               END DO
586            END DO            END DO
587            !IM "slab" ocean         else
588            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  
           IF (ocean == 'slab  ') THEN  
              IF (nsrf == is_oce) THEN  
                 tslab(1:klon) = ytslab(1:klon)  
                 seaice(1:klon) = y_seaice(1:klon)  
              END IF  
           END IF  
589         end IF if_knon         end IF if_knon
590      END DO loop_surface      END DO loop_surface
591    
592      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
593        frugs(:, is_oce) = rugmer
594        pctsrf(:, is_oce) = pctsrf_new_oce
595        pctsrf(:, is_sic) = pctsrf_new_sic
596    
597      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
598    
599    END SUBROUTINE clmain    END SUBROUTINE clmain
600    
Legend:
Removed from v.62  
changed lines
  Added in v.222
  ViewVC Help
Powered by ViewVC 1.1.21