/[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 155 by guez, Wed Jul 8 17:03:45 2015 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, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, ts, &         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         paprs, pplay, snow, qsurf, evap, falbe, fluxlat, rain_fall, snow_f, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, d_q, d_u, &
11         rain_fall, snow_f, solsw, sollw, fder, rlon, rlat, &         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
12         rugos, debut, agesno, rugoro, d_t, d_q, d_u, d_v, &         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, capcl, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, fqcalving, &
14         dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         ffonte, run_off_lic_0, flux_o, flux_g, tslab)
        capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &  
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)  
15    
16      ! 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
17      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
18      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
19    
20      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
21      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
22      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
23      ! sol.      ! de sol.
24    
25      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
26      ! 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",
27      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
28      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
29    
     use calendar, ONLY: ymds2ju  
30      use clqh_m, only: clqh      use clqh_m, only: clqh
31      use clvent_m, only: clvent      use clvent_m, only: clvent
32      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
# Line 39  contains Line 36  contains
36      USE dimens_m, ONLY: iim, jjm      USE dimens_m, ONLY: iim, jjm
37      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
38      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
39      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  
40      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
41        use stdlevvar_m, only: stdlevvar
42      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
     USE temps, ONLY: annee_ref, itau_phy  
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)
48      INTEGER, INTENT(IN):: itap ! numero du pas de temps      INTEGER, INTENT(IN):: itap ! numero du pas de temps
49      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
# Line 68  contains Line 56  contains
56      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
57      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
58      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
59      REAL co2_ppm ! taux CO2 atmosphere      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere
60      LOGICAL ok_veget      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
     CHARACTER(len=*), INTENT(IN):: ocean  
     REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
     LOGICAL, INTENT(IN):: soil_model  
61      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
62      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
63      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
64      REAL ftsoil(klon, nsoilmx, nbsrf)  
65      REAL qsol(klon)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
66        ! soil temperature of surface fraction
67    
68        REAL, INTENT(inout):: qsol(klon)
69        ! column-density of water in soil, in kg m-2
70    
71      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
72      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
73      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
74      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
75      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
76      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
77    
78      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
79    
80      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
81        ! liquid water mass flux (kg/m2/s), positive down
82    
83        REAL, intent(in):: snow_f(klon)
84        ! solid water mass flux (kg/m2/s), positive down
85    
86      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
87      REAL fder(klon)      REAL, intent(in):: fder(klon)
88      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
89    
90      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
91      ! rugos----input-R- longeur de rugosite (en m)      ! rugos----input-R- longeur de rugosite (en m)
# Line 108  contains Line 101  contains
101      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
102      ! changement pour "u" et "v"      ! changement pour "u" et "v"
103    
104      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
105    
106      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
107      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
# Line 123  contains Line 115  contains
115      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
116      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
117    
118      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
119      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
120      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
121      !IM "slab" ocean      !IM "slab" ocean
# Line 166  contains Line 158  contains
158      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
159      ! uniqmnt pour slab      ! uniqmnt pour slab
160    
     REAL seaice(klon)  
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
   
161      ! Local:      ! Local:
162    
163      REAL y_flux_o(klon), y_flux_g(klon)      REAL y_flux_o(klon), y_flux_g(klon)
164      real ytslab(klon)      real ytslab(klon)
     real y_seaice(klon)  
165      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
166      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
167    
# Line 183  contains Line 171  contains
171    
172      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
173      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
174      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
175      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
176      ! la premiere couche      ! la premiere couche
177      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
178      REAL yrain_f(klon), ysnow_f(klon)  
179        real yqsol(klon)
180        ! column-density of water in soil, in kg m-2
181    
182        REAL yrain_f(klon)
183        ! liquid water mass flux (kg/m2/s), positive down
184    
185        REAL ysnow_f(klon)
186        ! solid water mass flux (kg/m2/s), positive down
187    
188      REAL ysollw(klon), ysolsw(klon)      REAL ysollw(klon), ysolsw(klon)
189      REAL yfder(klon), ytaux(klon), ytauy(klon)      REAL yfder(klon)
190      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
191    
192      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 221  contains Line 217  contains
217      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
218    
219      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
220      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
221      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
222    
223      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
224    
     ! 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  
   
225      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
226      REAL yustar(klon)      REAL yustar(klon)
227      ! -- LOOP      ! -- LOOP
# Line 278  contains Line 256  contains
256    
257      ytherm = 0.      ytherm = 0.
258    
     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  
   
259      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
260         DO i = 1, klon         DO i = 1, klon
261            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 331  contains Line 280  contains
280      yts = 0.      yts = 0.
281      ysnow = 0.      ysnow = 0.
282      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
283      yrain_f = 0.      yrain_f = 0.
284      ysnow_f = 0.      ysnow_f = 0.
285      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
286      ysolsw = 0.      ysolsw = 0.
287      ysollw = 0.      ysollw = 0.
288      yrugos = 0.      yrugos = 0.
# Line 354  contains Line 299  contains
299      pctsrf_new = 0.      pctsrf_new = 0.
300      y_flux_u = 0.      y_flux_u = 0.
301      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
302      y_dflux_t = 0.      y_dflux_t = 0.
303      y_dflux_q = 0.      y_dflux_q = 0.
304      ytsoil = 999999.      ytsoil = 999999.
305      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
306      yu10mx = 0.      yu10mx = 0.
307      yu10my = 0.      yu10my = 0.
308      ywindsp = 0.      ywindsp = 0.
     ! -- LOOP  
309      d_ts = 0.      d_ts = 0.
     !§§§ PB  
310      yfluxlat = 0.      yfluxlat = 0.
311      flux_t = 0.      flux_t = 0.
312      flux_q = 0.      flux_q = 0.
# Line 377  contains Line 318  contains
318      d_v = 0.      d_v = 0.
319      ycoefh = 0.      ycoefh = 0.
320    
321      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
322        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
323      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! (\`a affiner)
     ! peut avoir potentiellement de la glace sur tout le domaine océanique  
     ! (à affiner)  
324    
325      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
326      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
327      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
328    
329        ! Boucler sur toutes les sous-fractions du sol:
330    
331      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
332         ! Chercher les indices :         ! Chercher les indices :
333         ni = 0         ni = 0
334         knon = 0         knon = 0
335         DO i = 1, klon         DO i = 1, klon
336            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
337            ! "potentielles"            ! "potentielles"
338            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
339               knon = knon + 1               knon = knon + 1
# Line 400  contains Line 341  contains
341            END IF            END IF
342         END DO         END DO
343    
        ! 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  
   
344         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
345            DO j = 1, knon            DO j = 1, knon
346               i = ni(j)               i = ni(j)
# Line 420  contains Line 349  contains
349               ytslab(i) = tslab(i)               ytslab(i) = tslab(i)
350               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
351               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
352               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
353               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
354               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
355               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
356               yfder(j) = fder(i)               yfder(j) = fder(i)
              ytaux(j) = flux_u(i, 1, nsrf)  
              ytauy(j) = flux_v(i, 1, nsrf)  
357               ysolsw(j) = solsw(i, nsrf)               ysolsw(j) = solsw(i, nsrf)
358               ysollw(j) = sollw(i, nsrf)               ysollw(j) = sollw(i, nsrf)
359               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
# Line 442  contains Line 368  contains
368               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
369            END DO            END DO
370    
371            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
372            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
373               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
374            ELSE            ELSE
375               yqsol = 0.               yqsol = 0.
376            END IF            END IF
# Line 493  contains Line 416  contains
416                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
417               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
418               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
419             END IF            END IF
420    
421            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
422               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
423               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
424               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
425                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
426                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 525  contains Line 448  contains
448               END DO               END DO
449    
450               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
451                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
452    
453               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  
454    
455               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
456                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
457                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
458                       yustar, iflag_pbl)                       iflag_pbl)
459               ELSE               ELSE
460                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
461                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 551  contains Line 471  contains
471            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
472                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
473    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
474            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
475            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
476                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
477                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
478                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
479                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &
480                 yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, y_flux_t, y_flux_q, &                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
481                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &
482                 y_flux_o, y_flux_g, ytslab, y_seaice)                 y_flux_g)
483    
484            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
485            yrugm = 0.            yrugm = 0.
# Line 599  contains Line 515  contains
515    
516            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
517    
518            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
519            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
520            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
521            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 608  contains Line 523  contains
523            DO j = 1, knon            DO j = 1, knon
524               i = ni(j)               i = ni(j)
525               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
526               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
527               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
528               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
529               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 629  contains Line 543  contains
543               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
544            END DO            END DO
545            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
546               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
547                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
548               DO j = 1, knon               DO j = 1, knon
549                  i = ni(j)                  i = ni(j)
550                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
551               END DO               END DO
552            END IF            END IF
553            !$$$ PB ajout pour soil  
554            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
555            DO k = 1, nsoilmx            DO k = 1, nsoilmx
556               DO j = 1, knon               DO j = 1, knon
# Line 660  contains Line 570  contains
570               END DO               END DO
571            END DO            END DO
572    
573            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
574    
575            DO j = 1, knon            DO j = 1, knon
576               i = ni(j)               i = ni(j)
# Line 696  contains Line 606  contains
606    
607            END DO            END DO
608    
609            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
610                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &
611                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
612    
# Line 736  contains Line 646  contains
646            IF (nsrf == is_sic) THEN            IF (nsrf == is_sic) THEN
647               DO j = 1, knon               DO j = 1, knon
648                  i = ni(j)                  i = ni(j)
649                  ! On pondère lorsque l'on fait le bilan au sol :                  ! On pond\`ere lorsque l'on fait le bilan au sol :
650                  IF (pctsrf_new(i, is_sic)>epsfra) THEN                  IF (pctsrf_new(i, is_sic)>epsfra) THEN
651                     flux_g(i) = y_flux_g(j)                     flux_g(i) = y_flux_g(j)
652                  ELSE                  ELSE
# Line 745  contains Line 655  contains
655               END DO               END DO
656    
657            END IF            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  
658         end IF if_knon         end IF if_knon
659      END DO loop_surface      END DO loop_surface
660    
Legend:
Removed from v.82  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21