/[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 186 by guez, Mon Mar 21 15:36: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 141  contains Line 124  contains
124      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
125      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
126    
127      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : pbl, hbtm (Comme les autres
128      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! diagnostics on cumule dans physiq ce qui permet de sortir les
129        ! grandeurs par sous-surface)
130      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf)
131      ! pblh------- HCL      ! pblh------- HCL
132      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
# Line 164  contains Line 148  contains
148      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
149      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
150    
     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  ')  
   
151      ! Local:      ! Local:
152    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
153      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
154      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
155    
# Line 190  contains Line 159  contains
159    
160      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
161      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
162      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
163      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
164      ! la premiere couche      ! la premiere couche
165      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
166      REAL yrain_f(klon), ysnow_f(klon)  
167      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      real yqsol(klon)
168      REAL yfder(klon), ytaux(klon), ytauy(klon)      ! column-density of water in soil, in kg m-2
169    
170        REAL yrain_f(klon)
171        ! liquid water mass flux (kg/m2/s), positive down
172    
173        REAL ysnow_f(klon)
174        ! solid water mass flux (kg/m2/s), positive down
175    
176        REAL yfder(klon)
177      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
178    
179      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 213  contains Line 189  contains
189      REAL yt(klon, klev), yq(klon, klev)      REAL yt(klon, klev), yq(klon, klev)
190      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)      REAL ypaprs(klon, klev+1), ypplay(klon, klev), ydelp(klon, klev)
191    
     LOGICAL ok_nonloc  
     PARAMETER (ok_nonloc=.FALSE.)  
192      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
193    
194      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 204  contains
204      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
205    
206      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
207      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
208      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
209    
210      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
211    
     ! 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  
   
212      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
213      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
214    
215      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
216      REAL ypblh(klon)      REAL ypblh(klon)
# Line 283  contains Line 234  contains
234      LOGICAL zxli      LOGICAL zxli
235      PARAMETER (zxli=.FALSE.)      PARAMETER (zxli=.FALSE.)
236    
     REAL zt, zqs, zdelta, zcor  
     REAL t_coup  
     PARAMETER (t_coup=273.15)  
   
     CHARACTER(len=20):: modname = 'clmain'  
   
237      !------------------------------------------------------------      !------------------------------------------------------------
238    
239      ytherm = 0.      ytherm = 0.
240    
     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  
   
241      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
242         DO i = 1, klon         DO i = 1, klon
243            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 346  contains Line 262  contains
262      yts = 0.      yts = 0.
263      ysnow = 0.      ysnow = 0.
264      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
265      yrain_f = 0.      yrain_f = 0.
266      ysnow_f = 0.      ysnow_f = 0.
267      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
     ysollwdown = 0.  
268      yrugos = 0.      yrugos = 0.
269      yu1 = 0.      yu1 = 0.
270      yv1 = 0.      yv1 = 0.
# Line 370  contains Line 279  contains
279      pctsrf_new = 0.      pctsrf_new = 0.
280      y_flux_u = 0.      y_flux_u = 0.
281      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
282      y_dflux_t = 0.      y_dflux_t = 0.
283      y_dflux_q = 0.      y_dflux_q = 0.
284      ytsoil = 999999.      ytsoil = 999999.
285      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
286      d_ts = 0.      d_ts = 0.
     !§§§ PB  
287      yfluxlat = 0.      yfluxlat = 0.
288      flux_t = 0.      flux_t = 0.
289      flux_q = 0.      flux_q = 0.
# Line 393  contains Line 295  contains
295      d_v = 0.      d_v = 0.
296      ycoefh = 0.      ycoefh = 0.
297    
298      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
299        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
300      ! 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)  
301    
302      pctsrf_pot = pctsrf      pctsrf_pot = pctsrf
303      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
304      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
305    
306        ! Boucler sur toutes les sous-fractions du sol:
307    
308      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
309         ! Chercher les indices :         ! Chercher les indices :
310         ni = 0         ni = 0
311         knon = 0         knon = 0
312         DO i = 1, klon         DO i = 1, klon
313            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
314            ! "potentielles"            ! "potentielles"
315            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
316               knon = knon + 1               knon = knon + 1
# Line 416  contains Line 318  contains
318            END IF            END IF
319         END DO         END DO
320    
        ! 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  
   
321         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
322            DO j = 1, knon            DO j = 1, knon
323               i = ni(j)               i = ni(j)
324               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
325               yts(j) = ts(i, nsrf)               yts(j) = ts(i, nsrf)
              ytslab(i) = tslab(i)  
326               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
327               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
328               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
329               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
330               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
331               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
332               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)  
333               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
334               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
335               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
336               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
337               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
338               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
339               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))  
340            END DO            END DO
341    
342            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
343            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
344               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
345            ELSE            ELSE
346               yqsol = 0.               yqsol = 0.
347            END IF            END IF
# Line 510  contains Line 387  contains
387                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
388               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
389               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
390             END IF            END IF
391    
392            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
393               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
394               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
395               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
396                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
397                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 542  contains Line 419  contains
419               END DO               END DO
420    
421               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
422                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
423    
424               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  
425    
426               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
427                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
428                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
429                       yustar, iflag_pbl)                       iflag_pbl)
430               ELSE               ELSE
431                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
432                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 568  contains Line 442  contains
442            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
443                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
444    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
445            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
446            CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, &            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &
447                 rlat, cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, &                 pctsrf, ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, &
448                 ytsoil, yqsol, ok_veget, ocean, npas, nexca, rmu0, &                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &
449                 co2_ppm, yrugos, yrugoro, yu1, yv1, coefh(:knon, :), &                 yrads, yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, &
450                 yt, yq, yts, ypaprs, ypplay, ydelp, yrads, yalb, &                 yfluxlat, pctsrf_new, yagesno(:knon), y_d_t, y_d_q, &
451                 yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, ytaux, &                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &
452                 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)  
453    
454            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
455            yrugm = 0.            yrugm = 0.
# Line 619  contains Line 485  contains
485    
486            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
487    
488            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
489            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
490            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
491            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 628  contains Line 493  contains
493            DO j = 1, knon            DO j = 1, knon
494               i = ni(j)               i = ni(j)
495               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
496               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
497               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
498               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
499               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 649  contains Line 513  contains
513               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
514            END DO            END DO
515            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
516               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
517                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
518               DO j = 1, knon               DO j = 1, knon
519                  i = ni(j)                  i = ni(j)
520                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
521               END DO               END DO
522            END IF            END IF
523            !$$$ PB ajout pour soil  
524            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
525            DO k = 1, nsoilmx            DO k = 1, nsoilmx
526               DO j = 1, knon               DO j = 1, knon
# Line 680  contains Line 540  contains
540               END DO               END DO
541            END DO            END DO
542    
543            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
544    
545            DO j = 1, knon            DO j = 1, knon
546               i = ni(j)               i = ni(j)
# Line 716  contains Line 576  contains
576    
577            END DO            END DO
578    
579            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &
580                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &
581                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
582    
583            DO j = 1, knon            DO j = 1, knon
# Line 740  contains Line 600  contains
600                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
601               END DO               END DO
602            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  
603         end IF if_knon         end IF if_knon
604      END DO loop_surface      END DO loop_surface
605    
Legend:
Removed from v.70  
changed lines
  Added in v.186
  ViewVC Help
Powered by ViewVC 1.1.21