/[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 223 by guez, Fri Apr 28 13:22:36 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, frugs, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         rain_fall, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         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(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
84        real agesno(klon, nbsrf)
85        REAL, INTENT(IN):: rugoro(klon)
86    
87      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
88      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
89      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
# Line 83  contains Line 91  contains
91      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
92      ! changement pour "u" et "v"      ! changement pour "u" et "v"
93    
94      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)  
96      !                    (orientation positive vers le bas)      REAL, intent(out):: flux_t(klon, nbsrf)
97      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
98      REAL dflux_t(klon), dflux_q(klon)      ! le bas) à la surface
99    
100        REAL, intent(out):: flux_q(klon, nbsrf)
101        ! flux de vapeur d'eau (kg/m2/s) à la surface
102    
103        REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104        ! tension du vent à la surface, en Pa
105    
106        REAL, INTENT(out):: cdragh(klon), cdragm(klon)
107        real q2(klon, klev+1, nbsrf)
108    
109        REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
110      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
111      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
112      !IM "slab" ocean      ! IM "slab" ocean
113      REAL flux_o(klon), flux_g(klon)  
114      !IM "slab" ocean      REAL, intent(out):: ycoefh(klon, klev)
115      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      REAL, intent(out):: zu1(klon)
116      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      REAL zv1(klon)
117      REAL y_flux_o(klon), y_flux_g(klon)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
118      REAL tslab(klon), ytslab(klon)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
119      ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
120      ! uniqmnt pour slab      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
121      REAL seaice(klon), y_seaice(klon)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
122      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! permet de sortir les grandeurs par sous-surface)
123      REAL y_fqcalving(klon), y_ffonte(klon)      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
124        REAL capcl(klon, nbsrf)
125        REAL oliqcl(klon, nbsrf)
126        REAL cteicl(klon, nbsrf)
127        REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
128        REAL therm(klon, nbsrf)
129        REAL trmb1(klon, nbsrf)
130        ! trmb1-------deep_cape
131        REAL trmb2(klon, nbsrf)
132        ! trmb2--------inhibition
133        REAL trmb3(klon, nbsrf)
134        ! trmb3-------Point Omega
135        REAL plcl(klon, nbsrf)
136      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
137      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
138      ! 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
139      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
140      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon)
141    
142      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)  
143    
144      REAL fluxlat(klon, nbsrf)      LOGICAL:: firstcal = .true.
145    
146      REAL, intent(in):: rain_fall(klon), snow_f(klon)      ! la nouvelle repartition des surfaces sortie de l'interface
147      REAL fder(klon)      REAL, save:: pctsrf_new_oce(klon)
148        REAL, save:: pctsrf_new_sic(klon)
149    
150      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
151      REAL rugos(klon, nbsrf)      real y_run_off_lic_0(klon)
152      ! rugos----input-R- longeur de rugosite (en m)      REAL rugmer(klon)
153        REAL ytsoil(klon, nsoilmx)
154        REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
155        REAL yalb(klon)
156    
157      REAL zcoefh(klon, klev)      REAL yu1(klon), yv1(klon)
158      REAL zu1(klon)      ! On ajoute en output yu1 et yv1 qui sont les vents dans
159      REAL zv1(klon)      ! la premi\`ere couche.
160        
161        REAL snow(klon), yqsurf(klon), yagesno(klon)
162    
163      !$$$ PB ajout pour soil      real yqsol(klon)
164      LOGICAL, INTENT(IN):: soil_model      ! column-density of water in soil, in kg m-2
     !IM ajout seuils cdrm, cdrh  
     REAL cdmmax, cdhmax  
165    
166      REAL ksta, ksta_ter      REAL yrain_f(klon)
167      LOGICAL ok_kzmin      ! liquid water mass flux (kg/m2/s), positive down
168    
169      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL ysnow_f(klon)
170      REAL ytsoil(klon, nsoilmx)      ! solid water mass flux (kg/m2/s), positive down
     REAL qsol(klon)  
171    
     REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(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)  
172      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
173      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
174      REAL y_d_ts(klon)      REAL y_d_ts(klon)
175      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
176      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
177      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
178      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
179      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
180      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
181      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
182      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
183      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
184    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
185      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
186    
187      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
188      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
189      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
190      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1)
191      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
192    
193      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
# Line 199  contains Line 197  contains
197      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
198    
199      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
200      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
201      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
202    
203      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)  
204    
205      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
206      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
207    
208      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  
209      REAL ypblh(klon)      REAL ypblh(klon)
210      REAL ylcl(klon)      REAL ylcl(klon)
211      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 271  contains Line 227  contains
227      LOGICAL zxli      LOGICAL zxli
228      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
229    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
230      !------------------------------------------------------------      !------------------------------------------------------------
231    
232      ytherm = 0.      ytherm = 0.
233    
     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  
   
234      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
235         DO i = 1, klon         DO i = 1, klon
236            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 331  contains Line 252  contains
252      zu1 = 0.      zu1 = 0.
253      zv1 = 0.      zv1 = 0.
254      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
255      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
256      yrain_f = 0.      yrain_f = 0.
257      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
258      yrugos = 0.      yrugos = 0.
259      yu1 = 0.      yu1 = 0.
260      yv1 = 0.      yv1 = 0.
     yrads = 0.  
261      ypaprs = 0.      ypaprs = 0.
262      ypplay = 0.      ypplay = 0.
263      ydelp = 0.      ydelp = 0.
# Line 355  contains Line 265  contains
265      yv = 0.      yv = 0.
266      yt = 0.      yt = 0.
267      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
268      y_dflux_t = 0.      y_dflux_t = 0.
269      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
270      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
271      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     yfluxlat = 0.  
272      flux_t = 0.      flux_t = 0.
273      flux_q = 0.      flux_q = 0.
274      flux_u = 0.      flux_u = 0.
275      flux_v = 0.      flux_v = 0.
276        fluxlat = 0.
277      d_t = 0.      d_t = 0.
278      d_q = 0.      d_q = 0.
279      d_u = 0.      d_u = 0.
280      d_v = 0.      d_v = 0.
281      zcoefh = 0.      ycoefh = 0.
282    
283      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
284        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
285      ! 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)  
286    
287      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
288        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
289      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
290      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
291    
292        ! Tester si c'est le moment de lire le fichier:
293        if (mod(itap - 1, lmt_pas) == 0) then
294           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
295        endif
296    
297        ! Boucler sur toutes les sous-fractions du sol:
298    
299      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
300         ! Chercher les indices :         ! Chercher les indices :
301         ni = 0         ni = 0
302         knon = 0         knon = 0
303         DO i = 1, klon         DO i = 1, klon
304            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
305            ! "potentielles"            ! "potentielles"
306            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
307               knon = knon + 1               knon = knon + 1
# Line 404  contains Line 309  contains
309            END IF            END IF
310         END DO         END DO
311    
        ! 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  
   
312         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
313            DO j = 1, knon            DO j = 1, knon
314               i = ni(j)               i = ni(j)
315               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
316               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
317               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
318               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
319               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
320               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
321               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
322               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
323               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              ytaux(j) = flux_u(i, 1, 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)  
324               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
325               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
326               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
327               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
328               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
329               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))  
330            END DO            END DO
331    
332            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
333            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
334               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
335            ELSE            ELSE
336               yqsol = 0.               yqsol = 0.
337            END IF            END IF
338    
339            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  
340    
341            DO k = 1, klev            DO k = 1, klev
342               DO j = 1, knon               DO j = 1, knon
# Line 478  contains Line 352  contains
352            END DO            END DO
353    
354            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
355            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
356                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
357                   coefh(:knon, :))
358            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
359               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
360               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
361               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
362            END IF            END IF
363    
364            ! on seuille coefm et coefh            ! on met un seuil pour coefm et coefh
365            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
366               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
367               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
# Line 495  contains Line 370  contains
370            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
371               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
372               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
373                    coefm(:, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
374               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
375               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
376             END IF            END IF
377    
378            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
379               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
380               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
381               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
382                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
383                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 530  contains Line 405  contains
405               END DO               END DO
406    
407               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
408                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
409    
410               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  
411    
412               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
413                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
414                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
415                       yustar, iflag_pbl)                       iflag_pbl)
416               ELSE               ELSE
417                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
418                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 551  contains Line 423  contains
423            END IF            END IF
424    
425            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
426            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yu, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
427                 ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
428            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yv, ypaprs, ypplay, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
429                 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)  
430    
431            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
432            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
433                 cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
434                 yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
435                 yrugoro, yu1, yv1, coefh, yt, yq, yts, ypaprs, ypplay, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
436                 ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
437                 yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw, &                 y_d_t, y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &
438                 yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 y_flux_q(:knon), y_dflux_t(:knon), y_dflux_q(:knon), &
439                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 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)  
440    
441            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
442            yrugm = 0.            yrugm = 0.
# Line 595  contains Line 461  contains
461                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
462                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
463                  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)  
464                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
465                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
466               END DO               END DO
467            END DO            END DO
468    
469            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
470              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
471              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
472              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
473    
474            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
475            alblw(:, nsrf) = 0.  
476            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
477              fsnow(:, nsrf) = 0.
478            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
479            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
482               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
483               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
484               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
485               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
486               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
487               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
488               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
489                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
490                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
491               END IF               END IF
492               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
493               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 636  contains Line 500  contains
500               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
501            END DO            END DO
502            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
503               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
504                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
505               DO j = 1, knon               DO j = 1, knon
506                  i = ni(j)                  i = ni(j)
507                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
508               END DO               END DO
509            END IF            END IF
510            !$$$ PB ajout pour soil  
511            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
512            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  
513    
514            DO j = 1, knon            DO j = 1, knon
515               i = ni(j)               i = ni(j)
# Line 663  contains Line 518  contains
518                  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)
519                  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)
520                  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)
521                  zcoefh(i, k) = zcoefh(i, k) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
522               END DO               END DO
523            END DO            END DO
524    
525            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
526    
527            DO j = 1, knon            DO j = 1, knon
528               i = ni(j)               i = ni(j)
# Line 680  contains Line 535  contains
535               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
536               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
537               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
538                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
539               END IF               END IF
540               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
541               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 700  contains Line 555  contains
555               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
556               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)
557               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)
   
558            END DO            END DO
559    
560            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
561                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
562                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
563    
564            DO j = 1, knon            DO j = 1, knon
565               i = ni(j)               i = ni(j)
# Line 727  contains Line 581  contains
581                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
582               END DO               END DO
583            END DO            END DO
584            !IM "slab" ocean         else
585            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  
586         end IF if_knon         end IF if_knon
587      END DO loop_surface      END DO loop_surface
588    
589      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
590        frugs(:, is_oce) = rugmer
591        pctsrf(:, is_oce) = pctsrf_new_oce
592        pctsrf(:, is_sic) = pctsrf_new_sic
593    
594      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
595    
596    END SUBROUTINE clmain    END SUBROUTINE clmain
597    
Legend:
Removed from v.62  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.21