/[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 236 by guez, Thu Nov 9 12:47:25 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, t2m, q2m, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &         u10m_srf, v10m_srf, 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    
     ! Pour pouvoir extraire les coefficients d'échanges et le vent  
     ! dans la première couche, trois champs ont été créés : "zcoefh",  
     ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois  
     ! champs sur les quatre sous-surfaces du modèle.  
   
     use calendar, ONLY: ymds2ju  
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
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
33      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  
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
37      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
38      USE temps, ONLY: annee_ref, itau_phy      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    
     ! Arguments:  
   
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(IN):: date0 ! jour initial  
     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):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
53        REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
54        REAL, INTENT(IN):: ksta, ksta_ter
55        LOGICAL, INTENT(IN):: ok_kzmin
56    
57        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
62    
63        REAL, INTENT(IN):: paprs(klon, klev + 1) ! pression a intercouche (Pa)
64      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
65      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
66      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      REAL qsurf(klon, nbsrf)
67      REAL cufi(klon), cvfi(klon)      REAL evap(klon, nbsrf)
68      ! cufi-----input-R- resolution des mailles en x (m)      REAL, intent(inout):: falbe(klon, nbsrf)
69      ! cvfi-----input-R- resolution des mailles en y (m)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
70    
71        REAL, intent(in):: rain_fall(klon)
72        ! liquid water mass flux (kg / m2 / s), positive down
73    
74        REAL, intent(in):: snow_f(klon)
75        ! solid water mass flux (kg / m2 / s), positive down
76    
77        REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
78        REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
79        real agesno(klon, nbsrf)
80        REAL, INTENT(IN):: rugoro(klon)
81    
82      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
83      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
84      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
# Line 83  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 flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
90      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)  
91      !                    (orientation positive vers le bas)      REAL, intent(out):: flux_t(klon, nbsrf)
92      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
93      REAL dflux_t(klon), dflux_q(klon)      ! le bas) à la surface
94    
95        REAL, intent(out):: flux_q(klon, nbsrf)
96        ! flux de vapeur d'eau (kg / m2 / s) à la surface
97    
98        REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99        ! tension du vent (flux turbulent de vent) à la surface, en Pa
100    
101        REAL, INTENT(out):: cdragh(klon), cdragm(klon)
102        real q2(klon, klev + 1, nbsrf)
103    
104        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      REAL flux_o(klon), flux_g(klon)  
109      !IM "slab" ocean      REAL, intent(out):: ycoefh(klon, klev)
110      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
111      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
112      REAL y_flux_o(klon), y_flux_g(klon)      ! ce champ sur les quatre sous-surfaces du mod\`ele.
113      REAL tslab(klon), ytslab(klon)  
114      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
115      ! uniqmnt pour slab  
116      REAL seaice(klon), y_seaice(klon)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! composantes du vent \`a 10m sans spirale d'Ekman
118      REAL y_fqcalving(klon), y_ffonte(klon)  
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)
124        REAL oliqcl(klon, nbsrf)
125        REAL cteicl(klon, nbsrf)
126        REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
127        REAL therm(klon, nbsrf)
128        REAL trmb1(klon, nbsrf)
129        ! trmb1-------deep_cape
130        REAL trmb2(klon, nbsrf)
131        ! trmb2--------inhibition
132        REAL trmb3(klon, nbsrf)
133        ! trmb3-------Point Omega
134        REAL plcl(klon, nbsrf)
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), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon)
   
     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  
     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)  
   
     REAL fluxlat(klon, nbsrf)  
140    
141      REAL, intent(in):: rain_fall(klon), snow_f(klon)      ! Local:
     REAL fder(klon)  
142    
143      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      LOGICAL:: firstcal = .true.
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
144    
145      REAL zcoefh(klon, klev)      ! la nouvelle repartition des surfaces sortie de l'interface
146      REAL zu1(klon)      REAL, save:: pctsrf_new_oce(klon)
147      REAL zv1(klon)      REAL, save:: pctsrf_new_sic(klon)
   
     !$$$ PB ajout pour soil  
     LOGICAL, INTENT(IN):: soil_model  
     !IM ajout seuils cdrm, cdrh  
     REAL cdmmax, cdhmax  
   
     REAL ksta, ksta_ter  
     LOGICAL ok_kzmin  
148    
149      REAL ftsoil(klon, nsoilmx, nbsrf)      REAL y_fqcalving(klon), y_ffonte(klon)
150        real y_run_off_lic_0(klon)
151        REAL rugmer(klon)
152      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
     REAL qsol(klon)  
   
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), yqsol(klon)  
     REAL yrain_f(klon), ysnow_f(klon)  
     REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)  
     REAL yfder(klon), ytaux(klon), ytauy(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)
   
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
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), q2(klon, klev+1, nbsrf)  
     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)
     ! 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)  
   
     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)
     !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  
188      REAL ypblh(klon)      REAL ypblh(klon)
189      REAL ylcl(klon)      REAL ylcl(klon)
190      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 260  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.)  
   
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
205      !------------------------------------------------------------      !------------------------------------------------------------
206    
207      ytherm = 0.      ytherm = 0.
208    
     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  
   
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 328  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.  
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 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 355  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.  
     !$$ PB  
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.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
236      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     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      zcoefh = 0.      ycoefh = 0.
   
     ! Boucler sur toutes les sous-fractions du sol:  
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:
263    
264      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
265         ! Chercher les indices :         ! Chercher les indices :
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 404  contains Line 274  contains
274            END IF            END IF
275         END DO         END DO
276    
        ! 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  
   
277         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
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)
              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)  
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            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
296            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) yqsol(:knon) = qsol(ni(:knon))
              DO j = 1, knon  
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
           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 478  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, 2:), &
320                      ycoefh0(:knon, 2:))
321                 ycoefm0(:knon, 1) = 0.
322                 ycoefh0(:knon, 1) = 0.
323               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
324               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
325            END IF            END IF
326    
327            ! on seuille coefm et coefh            ! on met un seuil pour coefm et coefh
328            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
329               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)               coefm(:knon, 1) = min(coefm(:knon, 1), cdmmax)
330               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)               coefh(:knon, 1) = min(coefh(:knon, 1), cdhmax)
# Line 495  contains Line 333  contains
333            IF (ok_kzmin) THEN            IF (ok_kzmin) THEN
334               ! Calcul d'une diffusion minimale pour les conditions tres stables               ! Calcul d'une diffusion minimale pour les conditions tres stables
335               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &               CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, &
336                    coefm(:, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0(:knon, 2:), ycoefh0(:knon, 2:))
337               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
338               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
339             END IF            END IF
340    
341            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 6) THEN
342               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
343               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
344               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
345                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
346                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
347    
348               DO k = 2, klev               DO k = 2, klev
349                  yzlay(1:knon, k) = yzlay(1:knon, k-1) &                  yzlay(:knon, k) = yzlay(:knon, k-1) &
350                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &                       + rd * 0.5 * (yt(1:knon, k-1) + yt(1:knon, k)) &
351                       / ypaprs(1:knon, k) &                       / ypaprs(1:knon, k) &
352                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
353               END DO               END DO
354    
355               DO k = 1, klev               DO k = 1, klev
356                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
357                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
358               END DO               END DO
359               yzlev(1:knon, 1) = 0.  
360               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               zlev(:knon, 1) = 0.
361                 zlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
362                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
363    
364               DO k = 2, klev               DO k = 2, klev
365                  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))
366               END DO               END DO
367    
368               DO k = 1, klev + 1               DO k = 1, klev + 1
369                  DO j = 1, knon                  DO j = 1, knon
370                     i = ni(j)                     i = ni(j)
# Line 529  contains Line 372  contains
372                  END DO                  END DO
373               END DO               END DO
374    
375               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               ustar(:knon) = ustarhb(yu(:knon, 1), yv(:knon, 1), coefm(:knon, 1))
376                 CALL yamada4(dtime, rg, zlev(:knon, :), yzlay(:knon, :), &
377               IF (prt_level > 9) THEN                    yu(:knon, :), yv(:knon, :), yteta(:knon, :), &
378                  PRINT *, 'USTAR = ', yustar                    coefm(:knon, 1), yq2(:knon, :), ykmm(:knon, :), &
379               END IF                    ykmn(:knon, :), ykmq(:knon, :), ustar(:knon))
   
              ! iflag_pbl peut être utilisé comme longueur de mélange  
   
              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  
   
380               coefm(:knon, 2:) = ykmm(:knon, 2:klev)               coefm(:knon, 2:) = ykmm(:knon, 2:klev)
381               coefh(:knon, 2:) = ykmn(:knon, 2:klev)               coefh(:knon, 2:) = ykmn(:knon, 2:klev)
382            END IF            END IF
383    
384            ! calculer la diffusion des vitesses "u" et "v"            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
385            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yu, ypaprs, ypplay, &                 coefm(:knon, 1), yt(:knon, :), yu(:knon, :), ypaprs(:knon, :), &
386                 ydelp, y_d_u, y_flux_u)                 ypplay(:knon, :), ydelp(:knon, :), y_d_u(:knon, :), &
387            CALL clvent(knon, dtime, yu1, yv1, coefm, yt, yv, ypaprs, ypplay, &                 y_flux_u(:knon))
388                 ydelp, y_d_v, y_flux_v)            CALL clvent(dtime, yu(:knon, 1), yv(:knon, 1), coefm(:knon, 2:), &
389                   coefm(:knon, 1), yt(:knon, :), yv(:knon, :), ypaprs(:knon, :), &
390            ! pour le couplage                 ypplay(:knon, :), ydelp(:knon, :), y_d_v(:knon, :), &
391            ytaux = y_flux_u(:, 1)                 y_flux_v(:knon))
           ytauy = y_flux_v(:, 1)  
392    
393            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
394            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
395                 cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
396                 yqsol, ok_veget, ocean, npas, nexca, rmu0, co2_ppm, yrugos, &                 yu(:knon, 1), yv(:knon, 1), coefh(:knon, 2:), coefh(:knon, 1), &
397                 yrugoro, yu1, yv1, coefh, yt, yq, yts, ypaprs, ypplay, &                 yt, yq, yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), &
398                 ydelp, yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, &                 yalb(:knon), snow(:knon), yqsurf, yrain_f, ysnow_f, &
399                 yfder, ytaux, ytauy, ywindsp, ysollw, ysollwdown, ysolsw, &                 yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, &
400                 yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, &                 y_d_ts(:knon), yz0_new, y_flux_t(:knon), y_flux_q(:knon), &
401                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &                 y_dflux_t(:knon), y_dflux_q(:knon), y_fqcalving, y_ffonte, &
402                 y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, &                 y_run_off_lic_0)
                ytslab, y_seaice)  
403    
404            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
405            yrugm = 0.            yrugm = 0.
406            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
407               DO j = 1, knon               DO j = 1, knon
408                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2) &
409                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
410                         / sqrt(coefm(j, 1) * (yu(j, 1)**2 + yv(j, 1)**2))
411                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
412               END DO               END DO
413            END IF            END IF
414            DO j = 1, knon            DO j = 1, knon
415               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
416               y_dflux_q(j) = y_dflux_q(j)*ypct(j)               y_dflux_q(j) = y_dflux_q(j) * ypct(j)
              yu1(j) = yu1(j)*ypct(j)  
              yv1(j) = yv1(j)*ypct(j)  
417            END DO            END DO
418    
419            DO k = 1, klev            DO k = 1, klev
420               DO j = 1, knon               DO j = 1, knon
421                  i = ni(j)                  i = ni(j)
422                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
423                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
424                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
425                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
426                  flux_t(i, k, nsrf) = y_flux_t(j, k)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
427                  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)  
428               END DO               END DO
429            END DO            END DO
430    
431            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
432              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
433              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
434              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
435    
436            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
437            alblw(:, nsrf) = 0.  
438            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
439              fsnow(:, nsrf) = 0.
440            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
441            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
442            DO j = 1, knon            DO j = 1, knon
443               i = ni(j)               i = ni(j)
444               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
445               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
446               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
447               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
448               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
449               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
450               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
451                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
452                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
453               END IF               END IF
454               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
455               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 632  contains Line 458  contains
458               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
459               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
460               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)  
461            END DO            END DO
462            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
463               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
464                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
465               DO j = 1, knon               DO j = 1, knon
466                  i = ni(j)                  i = ni(j)
467                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
468               END DO               END DO
469            END IF            END IF
470            !$$$ PB ajout pour soil  
471            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
472            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  
473    
474            DO j = 1, knon            DO j = 1, knon
475               i = ni(j)               i = ni(j)
# Line 663  contains Line 478  contains
478                  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)
479                  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)
480                  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)
481                  zcoefh(i, k) = zcoefh(i, k) + coefh(j, k)                  ycoefh(i, k) = ycoefh(i, k) + coefh(j, k)
482               END DO               END DO
483            END DO            END DO
484    
485            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
486    
487            DO j = 1, knon            DO j = 1, knon
488               i = ni(j)               i = ni(j)
489               uzon(j) = yu(j, 1) + y_d_u(j, 1)               u1(j) = yu(j, 1) + y_d_u(j, 1)
490               vmer(j) = yv(j, 1) + y_d_v(j, 1)               v1(j) = yv(j, 1) + y_d_v(j, 1)
491               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
492               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
493               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
494                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
495               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
496               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
497               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
498                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
499               END IF               END IF
500               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
501               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 688  contains Line 503  contains
503               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
504            END DO            END DO
505    
506            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, u1(:knon), v1(:knon), tair1(:knon), &
507                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, &
508                 yt10m, yq10m, yu10m, yustar)                 yq2m, yt10m, yq10m, wind10m(:knon), ustar)
509    
510            DO j = 1, knon            DO j = 1, knon
511               i = ni(j)               i = ni(j)
512               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
513               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
514    
515               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (wind10m(j) * u1(j)) &
516               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(u1(j)**2 + v1(j)**2)
517               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (wind10m(j) * v1(j)) &
518                      / sqrt(u1(j)**2 + v1(j)**2)
519            END DO            END DO
520    
521            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, ustar(:knon), y_flux_t(:knon), &
522                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
523                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
524    
525            DO j = 1, knon            DO j = 1, knon
526               i = ni(j)               i = ni(j)
# Line 727  contains Line 542  contains
542                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
543               END DO               END DO
544            END DO            END DO
545            !IM "slab" ocean         else
546            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  
547         end IF if_knon         end IF if_knon
548      END DO loop_surface      END DO loop_surface
549    
550      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
551        frugs(:, is_oce) = rugmer
552        pctsrf(:, is_oce) = pctsrf_new_oce
553        pctsrf(:, is_sic) = pctsrf_new_sic
554    
555      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
556    
557    END SUBROUTINE clmain    END SUBROUTINE clmain
558    
Legend:
Removed from v.62  
changed lines
  Added in v.236
  ViewVC Help
Powered by ViewVC 1.1.21