/[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 226 by guez, Mon Oct 16 13:04:05 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, t2m, q2m, &
12         rugos, debut, 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, 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    
     ! Pour pouvoir extraire les coefficients d'échanges et le vent  
     ! dans la première couche, trois champs ont été créés : "ycoefh",  
     ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois  
     ! champs sur les quatre sous-surfaces du modèle.  
   
     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 conf_gcm_m, ONLY: prt_level, lmt_pas
29      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
30      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
31      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
32      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  
33      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
34        USE interfoce_lim_m, ONLY: interfoce_lim
35        use stdlevvar_m, only: stdlevvar
36      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
37      USE temps, ONLY: annee_ref, itau_phy      use time_phylmdz, only: itap
38      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
39      use vdif_kcay_m, only: vdif_kcay      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(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 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  
53      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
54      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
55      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
56      REAL ftsoil(klon, nsoilmx, nbsrf)  
57      REAL qsol(klon)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
58      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      ! 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 snow(klon, nbsrf)      REAL, INTENT(inout):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
66      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
67      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
68      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
69      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
   
     REAL fluxlat(klon, nbsrf)  
70    
71      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
72      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  
73    
74      REAL rugos(klon, nbsrf)      REAL, intent(in):: snow_f(klon)
75      ! rugos----input-R- longeur de rugosite (en m)      ! solid water mass flux (kg / m2 / s), positive down
76    
77      LOGICAL, INTENT(IN):: debut      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)      real agesno(klon, nbsrf)
80      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
81    
# Line 108  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 d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
     ! d_ts-----output-R- le changement pour "ts"  
90    
91      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_t(klon, nbsrf)
92      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux de chaleur sensible (Cp T) (W / m2) (orientation positive vers
93      !                    (orientation positive vers le bas)      ! le bas) à la surface
94      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
95        REAL, intent(out):: flux_q(klon, nbsrf)
96      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      ! flux de vapeur d'eau (kg / m2 / s) à la surface
97      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
98      ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
99        ! tension du vent à la surface, en Pa
100    
101      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
102      real q2(klon, klev+1, nbsrf)      real q2(klon, klev + 1, nbsrf)
103    
104      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
105      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
106      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
107      !IM "slab" ocean      ! IM "slab" ocean
108    
109      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
110      REAL, intent(out):: zu1(klon)      ! Pour pouvoir extraire les coefficients d'\'echange, le champ
111      REAL zv1(klon)      ! "ycoefh" a \'et\'e cr\'e\'e. Nous avons moyenn\'e les valeurs de
112      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      ! ce champ sur les quatre sous-surfaces du mod\`ele.
113      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)  
114        REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
115      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds  
116      ! physiq ce qui permet de sortir les grdeurs par sous surface)      REAL, INTENT(inout):: u10m_srf(:, :), v10m_srf(:, :) ! (klon, nbsrf)
117      REAL pblh(klon, nbsrf)      ! composantes du vent \`a 10m sans spirale d'Ekman
118      ! pblh------- HCL  
119        ! Ionela Musat. Cf. Anne Mathieu : planetary boundary layer, hbtm.
120        ! Comme les autres diagnostics on cumule dans physiq ce qui permet
121        ! de sortir les grandeurs par sous-surface.
122        REAL pblh(klon, nbsrf) ! height of planetary boundary layer
123      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
124      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
125      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
126      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
127      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
128      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
129      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 154  contains Line 135  contains
135      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)      REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
136      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
137      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
138      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg / m2 / s
139      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
140    
141      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  
142    
143      REAL seaice(klon)      LOGICAL:: firstcal = .true.
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
144    
145      ! Local:      ! la nouvelle repartition des surfaces sortie de l'interface
146        REAL, save:: pctsrf_new_oce(klon)
147        REAL, save:: pctsrf_new_sic(klon)
148    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
149      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
150      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
151      REAL rugmer(klon)      REAL rugmer(klon)
   
152      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
153      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
154      REAL yalb(klon)      REAL yalb(klon)
     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)  
155    
156        REAL u1lay(klon), v1lay(klon) ! vent dans la premi\`ere couche, pour
157                                  ! une sous-surface donnée
158        
159        REAL snow(klon), yqsurf(klon), yagesno(klon)
160        real yqsol(klon) ! column-density of water in soil, in kg m-2
161        REAL yrain_f(klon) ! liquid water mass flux (kg / m2 / s), positive down
162        REAL ysnow_f(klon) ! solid water mass flux (kg / m2 / s), positive down
163        REAL yrugm(klon), yrads(klon), yrugoro(klon)
164      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
165      REAL y_d_ts(klon)      REAL y_d_ts(klon)
166      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
167      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
168      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
169      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
170      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
171      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
172      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
173      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
174      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev + 1), ypplay(klon, klev), ydelp(klon, klev)
175    
176      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
177    
178      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev + 1), yteta(klon, klev)
179      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev + 1), ykmn(klon, klev + 1)
180      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev + 1)
181      REAL yq2(klon, klev+1)      REAL yq2(klon, klev + 1)
182      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev + 1)
183    
     REAL u1lay(klon), v1lay(klon)  
184      REAL delp(klon, klev)      REAL delp(klon, klev)
185      INTEGER i, k, nsrf      INTEGER i, k, nsrf
186    
187      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
188    
189      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
190      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
191      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
192    
     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  
   
193      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
194      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
195    
196      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
197      REAL ypblh(klon)      REAL ypblh(klon)
# Line 278  contains Line 219  contains
219    
220      ytherm = 0.      ytherm = 0.
221    
     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  
   
222      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
223         DO i = 1, klon         DO i = 1, klon
224            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k + 1)
225         END DO         END DO
226      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  
227    
228      ! Initialization:      ! Initialization:
229      rugmer = 0.      rugmer = 0.
# Line 325  contains Line 231  contains
231      cdragm = 0.      cdragm = 0.
232      dflux_t = 0.      dflux_t = 0.
233      dflux_q = 0.      dflux_q = 0.
     zu1 = 0.  
     zv1 = 0.  
234      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
235      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
236      yrain_f = 0.      yrain_f = 0.
237      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
238      yrugos = 0.      yrugos = 0.
     yu1 = 0.  
     yv1 = 0.  
     yrads = 0.  
239      ypaprs = 0.      ypaprs = 0.
240      ypplay = 0.      ypplay = 0.
241      ydelp = 0.      ydelp = 0.
# Line 351  contains Line 243  contains
243      yv = 0.      yv = 0.
244      yt = 0.      yt = 0.
245      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
     !$$ PB  
246      y_dflux_t = 0.      y_dflux_t = 0.
247      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
248      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
249      d_ts = 0.      d_ts = 0.
     !§§§ PB  
     yfluxlat = 0.  
250      flux_t = 0.      flux_t = 0.
251      flux_q = 0.      flux_q = 0.
252      flux_u = 0.      flux_u = 0.
253      flux_v = 0.      flux_v = 0.
254        fluxlat = 0.
255      d_t = 0.      d_t = 0.
256      d_q = 0.      d_q = 0.
257      d_u = 0.      d_u = 0.
258      d_v = 0.      d_v = 0.
259      ycoefh = 0.      ycoefh = 0.
260    
261      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
262        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
263        ! (\`a affiner)
264    
265      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
266      ! peut avoir potentiellement de la glace sur tout le domaine océanique      pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
     ! (à affiner)  
   
     pctsrf_pot = pctsrf  
267      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
268      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
269    
270        ! Tester si c'est le moment de lire le fichier:
271        if (mod(itap - 1, lmt_pas) == 0) then
272           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
273        endif
274    
275        ! Boucler sur toutes les sous-fractions du sol:
276    
277      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
278         ! Chercher les indices :         ! Chercher les indices :
279         ni = 0         ni = 0
280         knon = 0         knon = 0
281         DO i = 1, klon         DO i = 1, klon
282            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
283            ! "potentielles"            ! "potentielles"
284            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
285               knon = knon + 1               knon = knon + 1
# Line 400  contains Line 287  contains
287            END IF            END IF
288         END DO         END DO
289    
        ! 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  
   
290         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
291            DO j = 1, knon            DO j = 1, knon
292               i = ni(j)               i = ni(j)
293               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
294               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
295               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
296               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
297               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
298               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
299               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
300               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
301               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)  
302               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
303               yu1(j) = u1lay(i)               u1lay(j) = u(i, 1)
304               yv1(j) = v1lay(i)               v1lay(j) = v(i, 1)
305               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
306               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev + 1) = paprs(i, klev + 1)
307               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))  
308            END DO            END DO
309    
310            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
311            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  
312    
313            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  
314    
315            DO k = 1, klev            DO k = 1, klev
316               DO j = 1, knon               DO j = 1, knon
# Line 473  contains Line 326  contains
326            END DO            END DO
327    
328            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
329            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
330                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
331                   coefh(:knon, :))
332            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
333               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
334               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 493  contains Line 347  contains
347                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
348               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
349               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
350             END IF            END IF
351    
352            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
353               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
354               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
355               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
356                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
357                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 508  contains Line 362  contains
362                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg                       * (ypplay(1:knon, k-1) - ypplay(1:knon, k)) / rg
363               END DO               END DO
364               DO k = 1, klev               DO k = 1, klev
365                  yteta(1:knon, k) = yt(1:knon, k)*(ypaprs(1:knon, 1) &                  yteta(1:knon, k) = yt(1:knon, k) * (ypaprs(1:knon, 1) &
366                       / ypplay(1:knon, k))**rkappa * (1.+0.61*yq(1:knon, k))                       / ypplay(1:knon, k))**rkappa * (1. + 0.61 * yq(1:knon, k))
367               END DO               END DO
368               yzlev(1:knon, 1) = 0.               yzlev(1:knon, 1) = 0.
369               yzlev(:knon, klev+1) = 2. * yzlay(:knon, klev) &               yzlev(:knon, klev + 1) = 2. * yzlay(:knon, klev) &
370                    - yzlay(:knon, klev - 1)                    - yzlay(:knon, klev - 1)
371               DO k = 2, klev               DO k = 2, klev
372                  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))
373               END DO               END DO
374               DO k = 1, klev + 1               DO k = 1, klev + 1
375                  DO j = 1, knon                  DO j = 1, knon
# Line 525  contains Line 379  contains
379               END DO               END DO
380    
381               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
382                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
383    
384               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  
385    
386               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
387                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
388                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
389                       yustar, iflag_pbl)                       iflag_pbl)
390               ELSE               ELSE
391                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
392                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 546  contains Line 397  contains
397            END IF            END IF
398    
399            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
400            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
401                 ypplay, ydelp, y_d_u, y_flux_u)                 coefm(:knon, :), yt, yu, ypaprs, ypplay, ydelp, y_d_u, &
402            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &                 y_flux_u(:knon))
403                 ypplay, ydelp, y_d_v, y_flux_v)            CALL clvent(knon, dtime, u1lay(:knon), v1lay(:knon), &
404                   coefm(:knon, :), yt, yv, ypaprs, ypplay, ydelp, y_d_v, &
405            ! pour le couplage                 y_flux_v(:knon))
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
406    
407            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
408            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
409                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 ytsoil(:knon, :), yqsol(:knon), mu0, yrugos, yrugoro, &
410                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 u1lay(:knon), v1lay(:knon), coefh(:knon, :), yt, yq, &
411                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yts(:knon), ypaprs, ypplay, ydelp, yrads(:knon), yalb(:knon), &
412                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 snow(:knon), yqsurf, yrain_f, ysnow_f, yfluxlat(:knon), &
413                 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), &
414                 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), &
415                 y_flux_o, y_flux_g, ytslab, y_seaice)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
416    
417            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
418            yrugm = 0.            yrugm = 0.
419            IF (nsrf == is_oce) THEN            IF (nsrf == is_oce) THEN
420               DO j = 1, knon               DO j = 1, knon
421                  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) &
422                       0.11*14E-6/sqrt(coefm(j, 1)*(yu1(j)**2+yv1(j)**2))                       / rg + 0.11 * 14E-6 &
423                         / sqrt(coefm(j, 1) * (u1lay(j)**2 + v1lay(j)**2))
424                  yrugm(j) = max(1.5E-05, yrugm(j))                  yrugm(j) = max(1.5E-05, yrugm(j))
425               END DO               END DO
426            END IF            END IF
427            DO j = 1, knon            DO j = 1, knon
428               y_dflux_t(j) = y_dflux_t(j)*ypct(j)               y_dflux_t(j) = y_dflux_t(j) * ypct(j)
429               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)  
430            END DO            END DO
431    
432            DO k = 1, klev            DO k = 1, klev
433               DO j = 1, knon               DO j = 1, knon
434                  i = ni(j)                  i = ni(j)
435                  coefh(j, k) = coefh(j, k)*ypct(j)                  coefh(j, k) = coefh(j, k) * ypct(j)
436                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k) * ypct(j)
437                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k) * ypct(j)
438                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k) * ypct(j)
439                  flux_t(i, k, nsrf) = y_flux_t(j, k)                  y_d_u(j, k) = y_d_u(j, k) * ypct(j)
440                  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)  
441               END DO               END DO
442            END DO            END DO
443    
444            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
445              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
446              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
447              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
448    
449              evap(:, nsrf) = -flux_q(:, nsrf)
450    
451            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
452            alblw(:, nsrf) = 0.            fsnow(:, nsrf) = 0.
           snow(:, nsrf) = 0.  
453            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
454            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
455            DO j = 1, knon            DO j = 1, knon
456               i = ni(j)               i = ni(j)
457               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
458               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
459               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
460               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
461               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
462               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
463               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
464                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
465                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
466               END IF               END IF
467               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
468               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 625  contains Line 471  contains
471               cdragm(i) = cdragm(i) + coefm(j, 1)               cdragm(i) = cdragm(i) + coefm(j, 1)
472               dflux_t(i) = dflux_t(i) + y_dflux_t(j)               dflux_t(i) = dflux_t(i) + y_dflux_t(j)
473               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)  
474            END DO            END DO
475            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
476               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
477                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
478               DO j = 1, knon               DO j = 1, knon
479                  i = ni(j)                  i = ni(j)
480                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
481               END DO               END DO
482            END IF            END IF
483            !$$$ PB ajout pour soil  
484            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
485            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  
486    
487            DO j = 1, knon            DO j = 1, knon
488               i = ni(j)               i = ni(j)
# Line 660  contains Line 495  contains
495               END DO               END DO
496            END DO            END DO
497    
498            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
499    
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
# Line 668  contains Line 503  contains
503               vmer(j) = yv(j, 1) + y_d_v(j, 1)               vmer(j) = yv(j, 1) + y_d_v(j, 1)
504               tair1(j) = yt(j, 1) + y_d_t(j, 1)               tair1(j) = yt(j, 1) + y_d_t(j, 1)
505               qair1(j) = yq(j, 1) + y_d_q(j, 1)               qair1(j) = yq(j, 1) + y_d_q(j, 1)
506               zgeo1(j) = rd*tair1(j)/(0.5*(ypaprs(j, 1)+ypplay(j, &               zgeo1(j) = rd * tair1(j) / (0.5 * (ypaprs(j, 1) + ypplay(j, &
507                    1)))*(ypaprs(j, 1)-ypplay(j, 1))                    1))) * (ypaprs(j, 1)-ypplay(j, 1))
508               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
509               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
510               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
511                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
512               END IF               END IF
513               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
514               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 681  contains Line 516  contains
516               qairsol(j) = yqsurf(j)               qairsol(j) = yqsurf(j)
517            END DO            END DO
518    
519            CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, &            CALL stdlevvar(klon, knon, nsrf, zxli, uzon(:knon), vmer(:knon), &
520                 zgeo1, tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, &                 tair1, qair1, zgeo1, tairsol, qairsol, rugo1, psfce, patm, &
521                 yt10m, yq10m, yu10m, yustar)                 yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
522    
523            DO j = 1, knon            DO j = 1, knon
524               i = ni(j)               i = ni(j)
525               t2m(i, nsrf) = yt2m(j)               t2m(i, nsrf) = yt2m(j)
526               q2m(i, nsrf) = yq2m(j)               q2m(i, nsrf) = yq2m(j)
527    
528               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               u10m_srf(i, nsrf) = (yu10m(j) * uzon(j)) &
529               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)                    / sqrt(uzon(j)**2 + vmer(j)**2)
530               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m_srf(i, nsrf) = (yu10m(j) * vmer(j)) &
531                      / sqrt(uzon(j)**2 + vmer(j)**2)
532            END DO            END DO
533    
534            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
535                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
536                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
537    
538            DO j = 1, knon            DO j = 1, knon
539               i = ni(j)               i = ni(j)
# Line 720  contains Line 555  contains
555                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
556               END DO               END DO
557            END DO            END DO
558            !IM "slab" ocean         else
559            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  
560         end IF if_knon         end IF if_knon
561      END DO loop_surface      END DO loop_surface
562    
563      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
564        frugs(:, is_oce) = rugmer
565        pctsrf(:, is_oce) = pctsrf_new_oce
566        pctsrf(:, is_sic) = pctsrf_new_sic
567    
568      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
569    
570    END SUBROUTINE clmain    END SUBROUTINE clmain
571    
Legend:
Removed from v.82  
changed lines
  Added in v.226
  ViewVC Help
Powered by ViewVC 1.1.21