/[lmdze]/trunk/Sources/phylmd/clmain.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/clmain.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/clmain.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/clmain.f revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, 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, fder, rlon, rlat, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         rugos, debut, agesno, rugoro, d_t, d_q, d_u, d_v, &         q2m, u10m_srf, v10m_srf, 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, ycoefh, 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 : "ycoefh",      ! 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(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 co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
     LOGICAL ok_veget  
     CHARACTER(len=*), INTENT(IN):: ocean  
     REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
     LOGICAL, INTENT(IN):: soil_model  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
61      REAL ftsoil(klon, nsoilmx, nbsrf)  
62      REAL qsol(klon)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      ! 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)
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 snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
74      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
   
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
77      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      ! liquid water mass flux (kg / m2 / s), positive down
     REAL fder(klon)  
     REAL, INTENT(IN):: rlon(klon)  
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
78    
79      REAL rugos(klon, nbsrf)      REAL, intent(in):: snow_f(klon)
80      ! rugos----input-R- longeur de rugosite (en m)      ! solid water mass flux (kg / m2 / s), positive down
81    
82      LOGICAL, INTENT(IN):: debut      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)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 108  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 d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95      ! d_ts-----output-R- le changement pour "ts"  
96        REAL, intent(out):: flux_t(klon, nbsrf)
97        ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
98        ! 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 flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! tension du vent à la surface, en Pa
     !                    (orientation positive vers le bas)  
     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
   
     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  
105    
106      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
107      real q2(klon, klev+1, nbsrf)      real q2(klon, klev + 1, nbsrf)
108    
109      REAL dflux_t(klon), dflux_q(klon)      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    
114      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
115      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon), zv1(klon)
116      REAL zv1(klon)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)  
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
119        ! composantes du vent \`a 10m sans spirale d'Ekman
120      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
121      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
122      REAL pblh(klon, nbsrf)      ! Comme les autres diagnostics on cumule dans physiq ce qui permet
123      ! pblh------- HCL      ! de sortir les grandeurs par sous-surface.
124        REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
128      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
129      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
130      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
131      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 154  contains Line 137  contains
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)      REAL run_off_lic_0(klon)
142    
143      REAL flux_o(klon), flux_g(klon)      ! Local:
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
144    
145      REAL seaice(klon)      LOGICAL:: firstcal = .true.
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
146    
147      ! Local:      ! la nouvelle repartition des surfaces sortie de l'interface
148        REAL, save:: pctsrf_new_oce(klon)
149        REAL, save:: pctsrf_new_sic(klon)
150    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
151      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
152      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
153      REAL rugmer(klon)      REAL rugmer(klon)
   
154      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
155      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156      REAL yalb(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)  
     REAL yfder(klon), ytaux(klon), ytauy(klon)  
     REAL yrugm(klon), yrads(klon), yrugoro(klon)  
157    
158        REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
159                                  ! une sous-surface donnée
160        
161        REAL snow(klon), yqsurf(klon), yagesno(klon)
162        real yqsol(klon) ! column-density of water in soil, in kg m-2
163        REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
164        REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
165        REAL yrugm(klon), yrads(klon), yrugoro(klon)
166      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
167      REAL y_d_ts(klon)      REAL y_d_ts(klon)
168      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
169      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
170      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
171      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
172      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
173      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
174      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
175      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
176      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
177    
178      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
179    
180      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
181      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
182      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
183      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
184      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
185    
     REAL u1lay(klon), v1lay(klon)  
186      REAL delp(klon, klev)      REAL delp(klon, klev)
187      INTEGER i, k, nsrf      INTEGER i, k, nsrf
188    
189      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
190    
191      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
192      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
193      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
194    
     REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.  
   
     ! 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  
   
195      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
196      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
197    
198      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
199      REAL ypblh(klon)      REAL ypblh(klon)
# Line 278  contains Line 221  contains
221    
222      ytherm = 0.      ytherm = 0.
223    
     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  
   
224      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
225         DO i = 1, klon         DO i = 1, klon
226            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
227         END DO         END DO
228      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  
229    
230      ! Initialization:      ! Initialization:
231      rugmer = 0.      rugmer = 0.
# Line 328  contains Line 236  contains
236      zu1 = 0.      zu1 = 0.
237      zv1 = 0.      zv1 = 0.
238      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
239      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
240      yrain_f = 0.      yrain_f = 0.
241      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
242      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
243      ypaprs = 0.      ypaprs = 0.
244      ypplay = 0.      ypplay = 0.
245      ydelp = 0.      ydelp = 0.
# Line 351  contains Line 247  contains
247      yv = 0.      yv = 0.
248      yt = 0.      yt = 0.
249      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
250      y_dflux_t = 0.      y_dflux_t = 0.
251      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
252      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
253      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     yfluxlat = 0.  
254      flux_t = 0.      flux_t = 0.
255      flux_q = 0.      flux_q = 0.
256      flux_u = 0.      flux_u = 0.
257      flux_v = 0.      flux_v = 0.
258        fluxlat = 0.
259      d_t = 0.      d_t = 0.
260      d_q = 0.      d_q = 0.
261      d_u = 0.      d_u = 0.
262      d_v = 0.      d_v = 0.
263      ycoefh = 0.      ycoefh = 0.
264    
265      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
266        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
267        ! (\`a affiner)
268    
269      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
270      ! peut avoir potentiellement de la glace sur tout le domaine océanique      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
     ! (à affiner)  
   
     pctsrf_pot = pctsrf  
271      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
272      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
273    
274        ! Tester si c'est le moment de lire le fichier:
275        if (mod(itap - 1, lmt_pas) == 0) then
276           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
277        endif
278    
279        ! Boucler sur toutes les sous-fractions du sol:
280    
281      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
282         ! Chercher les indices :         ! Chercher les indices :
283         ni = 0         ni = 0
284         knon = 0         knon = 0
285         DO i = 1, klon         DO i = 1, klon
286            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
287            ! "potentielles"            ! "potentielles"
288            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
289               knon = knon + 1               knon = knon + 1
# Line 400  contains Line 291  contains
291            END IF            END IF
292         END DO         END DO
293    
        ! 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  
   
294         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
295            DO j = 1, knon            DO j = 1, knon
296               i = ni(j)               i = ni(j)
297               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
298               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
299               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
300               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
301               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
302               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
303               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
304               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
305               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)  
              yrugos(j) = rugos(i, nsrf)  
306               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
307               yu1(j) = u1lay(i)               u1lay(j) = u(i, 1)
308               yv1(j) = v1lay(i)               v1lay(j) = v(i, 1)
309               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
310               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
311               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))  
312            END DO            END DO
313    
314            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
315            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  
316    
317            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  
318    
319            DO k = 1, klev            DO k = 1, klev
320               DO j = 1, knon               DO j = 1, knon
# Line 473  contains Line 330  contains
330            END DO            END DO
331    
332            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
333            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
334                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
335                   coefh(:knon, :))
336            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
337               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
338               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 493  contains Line 351  contains
351                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
352               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
353               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
354             END IF            END IF
355    
356            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
357               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
358               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
359               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
360                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
361                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 508  contains Line 366  contains
366                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
367               END DO               END DO
368               DO k = 1, klev               DO k = 1, klev
369                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
370                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
371               END DO               END DO
372               yzlev(1:knon, 1) = 0.               yzlev(1:knon, 1) = 0.
373               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
374                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
375               DO k = 2, klev               DO k = 2, klev
376                  yzlev(1:knon, k) = 0.5*(yzlay(1:knon, k)+yzlay(1:knon, k-1))                  yzlev(1:knon, k) = 0.5 * (yzlay(1:knon, k) + yzlay(1:knon, k-1))
377               END DO               END DO
378               DO k = 1, klev + 1               DO k = 1, klev + 1
379                  DO j = 1, knon                  DO j = 1, knon
# Line 525  contains Line 383  contains
383               END DO               END DO
384    
385               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
386                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
387    
388               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  
389    
390               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
391                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
392                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
393                       yustar, iflag_pbl)                       iflag_pbl)
394               ELSE               ELSE
395                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
396                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 546  contains Line 401  contains
401            END IF            END IF
402    
403            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
404            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
405                 ypplay, ydelp, y_d_u, y_flux_u)                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
406            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
407                 ypplay, ydelp, y_d_v, y_flux_v)            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
408                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
409            ! pour le couplage                 y_flux_v(:knon))
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
410    
411            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
412            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
413                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
414                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
415                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
416                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
417                 yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, y_flux_t, y_flux_q, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
418                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, &                 yz0_new, y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
419                 y_flux_o, y_flux_g, ytslab, y_seaice)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
420    
421            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
422            yrugm = 0.            yrugm = 0.
423            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
424               DO j = 1, knon               DO j = 1, knon
425                  yrugm(j) = 0.018*coefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &                  yrugm(j) = 0.018 * coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2) &
426                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
427                         / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
428                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
429               END DO               END DO
430            END IF            END IF
431            DO j = 1, knon            DO j = 1, knon
432               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
433               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)  
434            END DO            END DO
435    
436            DO k = 1, klev            DO k = 1, klev
437               DO j = 1, knon               DO j = 1, knon
438                  i = ni(j)                  i = ni(j)
439                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
440                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
441                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
442                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
443                  flux_t(i, k, nsrf) = y_flux_t(j, k)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
444                  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)  
445               END DO               END DO
446            END DO            END DO
447    
448            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
449              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
450              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
451              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
452    
453              evap(:, nsrf) = -flux_q(:, nsrf)
454    
455            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
456            alblw(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
           snow(:, nsrf) = 0.  
457            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
458            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
461               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
462               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
463               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
464               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
465               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
466               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
467               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
468                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
469                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
470               END IF               END IF
471               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
472               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 625  contains Line 475  contains
475               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
476               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
477               dflux_q(i) = dflux_q(i) + y_dflux_q(j)               dflux_q(i) = dflux_q(i) + y_dflux_q(j)
478               zu1(i) = zu1(i) + yu1(j)               zu1(i) = zu1(i) + u1lay(j) * ypct(j)
479               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + v1lay(j) * ypct(j)
480            END DO            END DO
481            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
482               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
483                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
484               DO j = 1, knon               DO j = 1, knon
485                  i = ni(j)                  i = ni(j)
486                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
487               END DO               END DO
488            END IF            END IF
489            !$$$ PB ajout pour soil  
490            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
491            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  
492    
493            DO j = 1, knon            DO j = 1, knon
494               i = ni(j)               i = ni(j)
# Line 660  contains Line 501  contains
501               END DO               END DO
502            END DO            END DO
503    
504            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
505    
506            DO j = 1, knon            DO j = 1, knon
507               i = ni(j)               i = ni(j)
# Line 668  contains Line 509  contains
509               vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
510               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
511               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
512               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
513                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
514               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
515               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
516               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
517                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
518               END IF               END IF
519               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
520               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 681  contains Line 522  contains
522               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
523            END DO            END DO
524    
525            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
526                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
527                 yt10m, yq10m, yu10m, yustar)                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
528    
529            DO j = 1, knon            DO j = 1, knon
530               i = ni(j)               i = ni(j)
531               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
532               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
533    
534               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
535               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(uzon(j)**2 + vmer(j)**2)
536               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
537                      / sqrt(uzon(j)**2 + vmer(j)**2)
538            END DO            END DO
539    
540            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
541                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
542                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
543    
544            DO j = 1, knon            DO j = 1, knon
545               i = ni(j)               i = ni(j)
# Line 720  contains Line 561  contains
561                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
562               END DO               END DO
563            END DO            END DO
564            !IM "slab" ocean         else
565            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  
566         end IF if_knon         end IF if_knon
567      END DO loop_surface      END DO loop_surface
568    
569      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
570        frugs(:, is_oce) = rugmer
571        pctsrf(:, is_oce) = pctsrf_new_oce
572        pctsrf(:, is_sic) = pctsrf_new_sic
573    
574      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
575    
576    END SUBROUTINE clmain    END SUBROUTINE clmain
577    
Legend:
Removed from v.82  
changed lines
  Added in v.225
  ViewVC Help
Powered by ViewVC 1.1.21