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

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

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

trunk/libf/phylmd/clmain.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC trunk/Sources/phylmd/clmain.f revision 154 by guez, Tue Jul 7 17:49:23 2015 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, date0, pctsrf, pctsrf_new, t, q, u, v, &    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, jour, rmu0, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, npas, nexca, 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, albe, alblw, fluxlat, rain_fall, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &
11         rain_fall, snow_f, solsw, sollw, sollwdown, fder, rlon, rlat, cufi, &         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &
12         cvfi, rugos, debut, lafin, agesno, rugoro, d_t, d_q, d_u, d_v, &         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &
        d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &  
        dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &  
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &
14         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)
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
     REAL, INTENT(IN):: date0 ! jour initial  
49      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50    
51      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
# Line 69  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  
     INTEGER npas, nexca  
     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)
# Line 90  contains Line 78  contains
78    
79      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
80    
81      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
82      REAL solsw(klon, nbsrf), sollw(klon, nbsrf), sollwdown(klon)      ! liquid water mass flux (kg/m2/s), positive down
83      REAL fder(klon)  
84      REAL, INTENT(IN):: rlon(klon)      REAL, intent(in):: snow_f(klon)
85      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      ! solid water mass flux (kg/m2/s), positive down
86    
87      REAL cufi(klon), cvfi(klon)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
88      ! cufi-----input-R- resolution des mailles en x (m)      REAL, intent(in):: fder(klon)
89      ! cvfi-----input-R- resolution des mailles en y (m)      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
90    
91      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
92      ! rugos----input-R- longeur de rugosite (en m)      ! rugos----input-R- longeur de rugosite (en m)
93    
94      LOGICAL, INTENT(IN):: debut      LOGICAL, INTENT(IN):: debut
     LOGICAL, INTENT(IN):: lafin  
95      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
96      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
97    
# Line 115  contains Line 102  contains
102      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
103      ! changement pour "u" et "v"      ! changement pour "u" et "v"
104    
105      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
106    
107      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
108      ! 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 130  contains Line 116  contains
116      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
117      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
118    
119      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
120      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
121      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
122      !IM "slab" ocean      !IM "slab" ocean
# Line 173  contains Line 159  contains
159      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
160      ! uniqmnt pour slab      ! uniqmnt pour slab
161    
     REAL seaice(klon)  
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
   
162      ! Local:      ! Local:
163    
164      REAL y_flux_o(klon), y_flux_g(klon)      REAL y_flux_o(klon), y_flux_g(klon)
165      real ytslab(klon)      real ytslab(klon)
     real y_seaice(klon)  
166      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
167      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
168    
# Line 194  contains Line 176  contains
176      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
177      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
178      ! la premiere couche      ! la premiere couche
179      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
180      REAL yrain_f(klon), ysnow_f(klon)  
181      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      real yqsol(klon)
182      REAL yfder(klon), ytaux(klon), ytauy(klon)      ! column-density of water in soil, in kg m-2
183    
184        REAL yrain_f(klon)
185        ! liquid water mass flux (kg/m2/s), positive down
186    
187        REAL ysnow_f(klon)
188        ! solid water mass flux (kg/m2/s), positive down
189    
190        REAL ysollw(klon), ysolsw(klon)
191        REAL yfder(klon)
192      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
193    
194      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 213  contains Line 204  contains
204      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
205      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
206    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
207      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
208    
209      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
# Line 230  contains Line 219  contains
219      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
220    
221      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
222      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
223      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
224    
225      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
226    
     ! 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  
   
227      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
228      REAL yustar(klon)      REAL yustar(klon)
229      ! -- LOOP      ! -- LOOP
# Line 283  contains Line 254  contains
254      LOGICAL zxli      LOGICAL zxli
255      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
256    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
257      !------------------------------------------------------------      !------------------------------------------------------------
258    
259      ytherm = 0.      ytherm = 0.
260    
     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  
   
261      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
262         DO i = 1, klon         DO i = 1, klon
263            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 347  contains Line 283  contains
283      ysnow = 0.      ysnow = 0.
284      yqsurf = 0.      yqsurf = 0.
285      yalb = 0.      yalb = 0.
     yalblw = 0.  
286      yrain_f = 0.      yrain_f = 0.
287      ysnow_f = 0.      ysnow_f = 0.
288      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
289      ysolsw = 0.      ysolsw = 0.
290      ysollw = 0.      ysollw = 0.
     ysollwdown = 0.  
291      yrugos = 0.      yrugos = 0.
292      yu1 = 0.      yu1 = 0.
293      yv1 = 0.      yv1 = 0.
# Line 370  contains Line 302  contains
302      pctsrf_new = 0.      pctsrf_new = 0.
303      y_flux_u = 0.      y_flux_u = 0.
304      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
305      y_dflux_t = 0.      y_dflux_t = 0.
306      y_dflux_q = 0.      y_dflux_q = 0.
307      ytsoil = 999999.      ytsoil = 999999.
308      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
309      yu10mx = 0.      yu10mx = 0.
310      yu10my = 0.      yu10my = 0.
311      ywindsp = 0.      ywindsp = 0.
     ! -- LOOP  
312      d_ts = 0.      d_ts = 0.
     !§§§ PB  
313      yfluxlat = 0.      yfluxlat = 0.
314      flux_t = 0.      flux_t = 0.
315      flux_q = 0.      flux_q = 0.
# Line 393  contains Line 321  contains
321      d_v = 0.      d_v = 0.
322      ycoefh = 0.      ycoefh = 0.
323    
324      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
325        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
326      ! 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)  
327    
328      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
329      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
330      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
331    
332        ! Boucler sur toutes les sous-fractions du sol:
333    
334      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
335         ! Chercher les indices :         ! Chercher les indices :
336         ni = 0         ni = 0
337         knon = 0         knon = 0
338         DO i = 1, klon         DO i = 1, klon
339            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
340            ! "potentielles"            ! "potentielles"
341            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
342               knon = knon + 1               knon = knon + 1
# Line 416  contains Line 344  contains
344            END IF            END IF
345         END DO         END DO
346    
        ! 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  
   
347         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
348            DO j = 1, knon            DO j = 1, knon
349               i = ni(j)               i = ni(j)
# Line 437  contains Line 353  contains
353               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
354               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
355               yalb(j) = albe(i, nsrf)               yalb(j) = albe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
356               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
357               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
358               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
359               yfder(j) = fder(i)               yfder(j) = fder(i)
              ytaux(j) = flux_u(i, 1, nsrf)  
              ytauy(j) = flux_v(i, 1, nsrf)  
360               ysolsw(j) = solsw(i, nsrf)               ysolsw(j) = solsw(i, nsrf)
361               ysollw(j) = sollw(i, nsrf)               ysollw(j) = sollw(i, nsrf)
              ysollwdown(j) = sollwdown(i)  
362               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
363               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
364               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
# Line 459  contains Line 371  contains
371               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))               ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
372            END DO            END DO
373    
374            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
375            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
376               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
377            ELSE            ELSE
378               yqsol = 0.               yqsol = 0.
379            END IF            END IF
# Line 510  contains Line 419  contains
419                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
420               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
421               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
422             END IF            END IF
423    
424            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
425               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
426               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
427               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
428                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
429                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 542  contains Line 451  contains
451               END DO               END DO
452    
453               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
454                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
455    
456               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  
457    
458               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
459                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
460                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
461                       yustar, iflag_pbl)                       iflag_pbl)
462               ELSE               ELSE
463                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
464                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 568  contains Line 474  contains
474            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
475                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
476    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
477            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
478            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
479                 rlat, cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, &                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &
480                 ytsoil, yqsol, ok_veget, ocean, npas, nexca, rmu0, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
481                 co2_ppm, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), &                 yrads, yalb, yalblw(:knon), ysnow, yqsurf, yrain_f, ysnow_f, &
482                 yt, yq, yts, ypaprs, ypplay, ydelp, yrads, yalb, &                 yfder, ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &
483                 yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, ytaux, &                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
484                 ytauy, ywindsp, ysollw, ysollwdown, ysolsw, yfluxlat, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &
485                 pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, &                 y_flux_g)
                y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, y_fqcalving, &  
                y_ffonte, y_run_off_lic_0, y_flux_o, y_flux_g, ytslab, &  
                y_seaice)  
486    
487            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
488            yrugm = 0.            yrugm = 0.
# Line 649  contains Line 548  contains
548               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
549            END DO            END DO
550            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
551               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
552                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
553               DO j = 1, knon               DO j = 1, knon
554                  i = ni(j)                  i = ni(j)
555                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
556               END DO               END DO
557            END IF            END IF
558            !$$$ PB ajout pour soil  
559            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
560            DO k = 1, nsoilmx            DO k = 1, nsoilmx
561               DO j = 1, knon               DO j = 1, knon
# Line 680  contains Line 575  contains
575               END DO               END DO
576            END DO            END DO
577    
578            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
579    
580            DO j = 1, knon            DO j = 1, knon
581               i = ni(j)               i = ni(j)
# Line 716  contains Line 611  contains
611    
612            END DO            END DO
613    
614            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
615                 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, &
616                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
617    
# Line 756  contains Line 651  contains
651            IF (nsrf == is_sic) THEN            IF (nsrf == is_sic) THEN
652               DO j = 1, knon               DO j = 1, knon
653                  i = ni(j)                  i = ni(j)
654                  ! On pondère lorsque l'on fait le bilan au sol :                  ! On pond\`ere lorsque l'on fait le bilan au sol :
655                  IF (pctsrf_new(i, is_sic)>epsfra) THEN                  IF (pctsrf_new(i, is_sic)>epsfra) THEN
656                     flux_g(i) = y_flux_g(j)                     flux_g(i) = y_flux_g(j)
657                  ELSE                  ELSE
# Line 765  contains Line 660  contains
660               END DO               END DO
661    
662            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  
663         end IF if_knon         end IF if_knon
664      END DO loop_surface      END DO loop_surface
665    
Legend:
Removed from v.71  
changed lines
  Added in v.154
  ViewVC Help
Powered by ViewVC 1.1.21