/[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 70 by guez, Mon Jun 24 15:39:52 2013 UTC trunk/Sources/phylmd/clmain.f revision 178 by guez, Fri Mar 11 18:47:26 2016 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, &         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, sollwdown, fder, rlon, rlat, cufi, &         d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &
12         cvfi, rugos, debut, lafin, 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)
        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
33      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
34      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level
35      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
36      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
38      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  
39      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
40        use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
     USE temps, ONLY: annee_ref, itau_phy  
42      use ustarhb_m, only: ustarhb      use ustarhb_m, only: ustarhb
43      use vdif_kcay_m, only: vdif_kcay      use vdif_kcay_m, only: vdif_kcay
44      use yamada4_m, only: yamada4      use yamada4_m, only: yamada4
45    
     ! Arguments:  
   
46      REAL, INTENT(IN):: dtime ! interval du temps (secondes)      REAL, INTENT(IN):: dtime ! interval du temps (secondes)
47      INTEGER, INTENT(IN):: itap ! numero du pas de temps      INTEGER, INTENT(IN):: itap ! numero du pas de temps
     REAL, INTENT(IN):: date0 ! jour initial  
48      REAL, INTENT(inout):: pctsrf(klon, nbsrf)      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
49    
50      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
# Line 69  contains Line 55  contains
55      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
56      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
57      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
58      REAL co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
59      LOGICAL ok_veget      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
60      CHARACTER(len=*), INTENT(IN):: ocean      REAL, INTENT(IN):: ksta, ksta_ter
61      INTEGER npas, nexca      LOGICAL, INTENT(IN):: ok_kzmin
62      REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
63      LOGICAL, INTENT(IN):: soil_model      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
64      REAL cdmmax, cdhmax ! seuils cdrm, cdrh      ! soil temperature of surface fraction
65      REAL ksta, ksta_ter  
66      LOGICAL ok_kzmin      REAL, INTENT(inout):: qsol(klon)
67      REAL ftsoil(klon, nsoilmx, nbsrf)      ! column-density of water in soil, in kg m-2
68      REAL qsol(klon)  
69      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
70      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
71      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
72      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
73      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
74      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
75    
76      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
77    
78      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
79      REAL solsw(klon, nbsrf), sollw(klon, nbsrf), sollwdown(klon)      ! liquid water mass flux (kg/m2/s), positive down
80      REAL fder(klon)  
81      REAL, INTENT(IN):: rlon(klon)      REAL, intent(in):: snow_f(klon)
82      REAL, INTENT(IN):: rlat(klon) ! latitude en degrés      ! solid water mass flux (kg/m2/s), positive down
83    
84      REAL cufi(klon), cvfi(klon)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
85      ! cufi-----input-R- resolution des mailles en x (m)      REAL, intent(in):: fder(klon)
86      ! cvfi-----input-R- resolution des mailles en y (m)      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
87    
88      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
89      ! rugos----input-R- longeur de rugosite (en m)      ! rugos----input-R- longeur de rugosite (en m)
90    
91      LOGICAL, INTENT(IN):: debut      LOGICAL, INTENT(IN):: debut
     LOGICAL, INTENT(IN):: lafin  
92      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
93      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
94    
# Line 115  contains Line 99  contains
99      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
100      ! changement pour "u" et "v"      ! changement pour "u" et "v"
101    
102      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
103    
104      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
105      ! 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 113  contains
113      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
114      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
115    
116      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
117      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
118      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
119      !IM "slab" ocean      !IM "slab" ocean
# Line 164  contains Line 147  contains
147      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
148      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
149    
     REAL flux_o(klon), flux_g(klon)  
     !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  
   
     REAL seaice(klon)  
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
   
150      ! Local:      ! Local:
151    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
152      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
153      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
154    
# Line 190  contains Line 158  contains
158    
159      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
160      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
161      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
162      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
163      ! la premiere couche      ! la premiere couche
164      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
165      REAL yrain_f(klon), ysnow_f(klon)  
166      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      real yqsol(klon)
167      REAL yfder(klon), ytaux(klon), ytauy(klon)      ! column-density of water in soil, in kg m-2
168    
169        REAL yrain_f(klon)
170        ! liquid water mass flux (kg/m2/s), positive down
171    
172        REAL ysnow_f(klon)
173        ! solid water mass flux (kg/m2/s), positive down
174    
175        REAL yfder(klon)
176      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
177    
178      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 213  contains Line 188  contains
188      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
189      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
190    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
191      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
192    
193      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 203  contains
203      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
204    
205      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
206      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
207      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
208    
209      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
210    
     ! 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  
   
211      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
212      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
213    
214      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
215      REAL ypblh(klon)      REAL ypblh(klon)
# Line 283  contains Line 233  contains
233      LOGICAL zxli      LOGICAL zxli
234      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
235    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
236      !------------------------------------------------------------      !------------------------------------------------------------
237    
238      ytherm = 0.      ytherm = 0.
239    
     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  
   
240      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
241         DO i = 1, klon         DO i = 1, klon
242            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 346  contains Line 261  contains
261      yts = 0.      yts = 0.
262      ysnow = 0.      ysnow = 0.
263      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
264      yrain_f = 0.      yrain_f = 0.
265      ysnow_f = 0.      ysnow_f = 0.
266      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
267      yrugos = 0.      yrugos = 0.
268      yu1 = 0.      yu1 = 0.
269      yv1 = 0.      yv1 = 0.
# Line 370  contains Line 278  contains
278      pctsrf_new = 0.      pctsrf_new = 0.
279      y_flux_u = 0.      y_flux_u = 0.
280      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
281      y_dflux_t = 0.      y_dflux_t = 0.
282      y_dflux_q = 0.      y_dflux_q = 0.
283      ytsoil = 999999.      ytsoil = 999999.
284      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
285      d_ts = 0.      d_ts = 0.
     !§§§ PB  
286      yfluxlat = 0.      yfluxlat = 0.
287      flux_t = 0.      flux_t = 0.
288      flux_q = 0.      flux_q = 0.
# Line 393  contains Line 294  contains
294      d_v = 0.      d_v = 0.
295      ycoefh = 0.      ycoefh = 0.
296    
297      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
298        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
299      ! 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)  
300    
301      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
302      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
303      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
304    
305        ! Boucler sur toutes les sous-fractions du sol:
306    
307      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
308         ! Chercher les indices :         ! Chercher les indices :
309         ni = 0         ni = 0
310         knon = 0         knon = 0
311         DO i = 1, klon         DO i = 1, klon
312            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
313            ! "potentielles"            ! "potentielles"
314            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
315               knon = knon + 1               knon = knon + 1
# Line 416  contains Line 317  contains
317            END IF            END IF
318         END DO         END DO
319    
        ! 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  
   
320         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
321            DO j = 1, knon            DO j = 1, knon
322               i = ni(j)               i = ni(j)
323               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
324               yts(j) = ts(i, nsrf)               yts(j) = ts(i, nsrf)
              ytslab(i) = tslab(i)  
325               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
326               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
327               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
328               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
329               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
330               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
331               yfder(j) = fder(i)               yfder(j) = fder(i)
              ytaux(j) = flux_u(i, 1, nsrf)  
              ytauy(j) = flux_v(i, 1, nsrf)  
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
              ysollwdown(j) = sollwdown(i)  
332               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
333               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
334               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
335               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
336               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
337               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
338               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))  
339            END DO            END DO
340    
341            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
342            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
343               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
344            ELSE            ELSE
345               yqsol = 0.               yqsol = 0.
346            END IF            END IF
# Line 510  contains Line 386  contains
386                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
387               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
388               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
389             END IF            END IF
390    
391            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
392               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
393               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
394               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
395                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
396                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 542  contains Line 418  contains
418               END DO               END DO
419    
420               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
421                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
422    
423               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  
424    
425               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
426                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
427                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
428                       yustar, iflag_pbl)                       iflag_pbl)
429               ELSE               ELSE
430                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
431                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 568  contains Line 441  contains
441            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
442                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
443    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
444            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
445            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
446                 rlat, cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, &                 pctsrf, ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, &
447                 ytsoil, yqsol, ok_veget, ocean, npas, nexca, rmu0, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
448                 co2_ppm, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), &                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
449                 yt, yq, yts, ypaprs, ypplay, ydelp, yrads, yalb, &                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &
450                 yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, ytaux, &                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
451                 ytauy, ywindsp, ysollw, ysollwdown, ysolsw, yfluxlat, &                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0)
                pctsrf_new, yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, &  
                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)  
452    
453            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
454            yrugm = 0.            yrugm = 0.
# Line 619  contains Line 484  contains
484    
485            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
486    
487            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
488            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
489            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
490            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 628  contains Line 492  contains
492            DO j = 1, knon            DO j = 1, knon
493               i = ni(j)               i = ni(j)
494               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
495               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
496               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
497               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
498               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 649  contains Line 512  contains
512               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
513            END DO            END DO
514            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
515               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
516                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
517               DO j = 1, knon               DO j = 1, knon
518                  i = ni(j)                  i = ni(j)
519                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
520               END DO               END DO
521            END IF            END IF
522            !$$$ PB ajout pour soil  
523            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
524            DO k = 1, nsoilmx            DO k = 1, nsoilmx
525               DO j = 1, knon               DO j = 1, knon
# Line 680  contains Line 539  contains
539               END DO               END DO
540            END DO            END DO
541    
542            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
543    
544            DO j = 1, knon            DO j = 1, knon
545               i = ni(j)               i = ni(j)
# Line 716  contains Line 575  contains
575    
576            END DO            END DO
577    
578            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, &
579                 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, &
580                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
581    
# Line 740  contains Line 599  contains
599                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
600               END DO               END DO
601            END DO            END DO
           !IM "slab" ocean  
           IF (nsrf == is_oce) THEN  
              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  
602         end IF if_knon         end IF if_knon
603      END DO loop_surface      END DO loop_surface
604    
Legend:
Removed from v.70  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21