/[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 202 by guez, Wed Jun 8 12:23:41 2016 UTC
# Line 4  module clmain_m Line 4  module clmain_m
4    
5  contains  contains
6    
7    SUBROUTINE clmain(dtime, itap, pctsrf, pctsrf_new, t, q, u, v, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, jour, rmu0, ts, cdmmax, &
8         jour, rmu0, co2_ppm, ok_veget, ocean, ts, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, snow, &
9         soil_model, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, solsw, sollw, fder, &
10         qsol, paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, &         rlat, rugos, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         rain_fall, snow_f, solsw, sollw, fder, rlon, rlat, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         rugos, debut, agesno, rugoro, d_t, d_q, d_u, d_v, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, q2, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &  
        capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &  
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)  
14    
15      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19      ! From phylmd/clmain.F, version 1.6, 2005/11/16 14:47:19
16      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18      ! Author: Z. X. Li (LMD/CNRS), date: 1993/08/18
17      ! Objet : interface de couche limite (diffusion verticale)      ! Objet : interface de couche limite (diffusion verticale)
18    
19      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul      ! Tout ce qui a trait aux traceurs est dans "phytrac". Le calcul
20      ! de la couche limite pour les traceurs se fait avec "cltrac" et      ! de la couche limite pour les traceurs se fait avec "cltrac" et
21      ! ne tient pas compte de la différentiation des sous-fractions de      ! ne tient pas compte de la diff\'erentiation des sous-fractions
22      ! sol.      ! de sol.
23    
24      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'\'echanges et le vent
25      ! 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",
26      ! "zu1" et "zv1". Nous avons moyenné les valeurs de ces trois      ! "zu1" et "zv1". Nous avons moyenn\'e les valeurs de ces trois
27      ! champs sur les quatre sous-surfaces du modèle.      ! champs sur les quatre sous-surfaces du mod\`ele.
28    
     use calendar, ONLY: ymds2ju  
29      use clqh_m, only: clqh      use clqh_m, only: clqh
30      use clvent_m, only: clvent      use clvent_m, only: clvent
31      use coefkz_m, only: coefkz      use coefkz_m, only: coefkz
32      use coefkzmin_m, only: coefkzmin      use coefkzmin_m, only: coefkzmin
33      USE conf_gcm_m, ONLY: prt_level      USE conf_gcm_m, ONLY: prt_level, lmt_pas
34      USE conf_phys_m, ONLY: iflag_pbl      USE conf_phys_m, ONLY: iflag_pbl
     USE dimens_m, ONLY: iim, jjm  
35      USE dimphy, ONLY: klev, klon, zmasq      USE dimphy, ONLY: klev, klon, zmasq
36      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
     USE dynetat0_m, ONLY: day_ini  
     USE gath_cpl, ONLY: gath2cpl  
37      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  
38      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
39        USE interfoce_lim_m, ONLY: interfoce_lim
40        use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42      USE temps, ONLY: annee_ref, itau_phy      use time_phylmdz, only: itap
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)
     INTEGER, INTENT(IN):: itap ! numero du pas de temps  
     REAL, INTENT(inout):: pctsrf(klon, nbsrf)  
48    
49      ! la nouvelle repartition des surfaces sortie de l'interface      REAL, INTENT(inout):: pctsrf(klon, nbsrf)
50      REAL, INTENT(out):: pctsrf_new(klon, nbsrf)      ! tableau des pourcentages de surface de chaque maille
51    
52      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)      REAL, INTENT(IN):: t(klon, klev) ! temperature (K)
53      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)      REAL, INTENT(IN):: q(klon, klev) ! vapeur d'eau (kg/kg)
54      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse      REAL, INTENT(IN):: u(klon, klev), v(klon, klev) ! vitesse
55      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours      INTEGER, INTENT(IN):: jour ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)
     LOGICAL ok_veget  
     CHARACTER(len=*), INTENT(IN):: ocean  
     REAL ts(klon, nbsrf) ! input-R- temperature du sol (en Kelvin)  
     LOGICAL, INTENT(IN):: soil_model  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
61      REAL ftsoil(klon, nsoilmx, nbsrf)  
62      REAL qsol(klon)      REAL, INTENT(inout):: ftsoil(klon, nsoilmx, nbsrf)
63        ! soil temperature of surface fraction
64    
65        REAL, INTENT(inout):: qsol(klon)
66        ! column-density of water in soil, in kg m-2
67    
68      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)      REAL, INTENT(IN):: paprs(klon, klev+1) ! pression a intercouche (Pa)
69      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)      REAL, INTENT(IN):: pplay(klon, klev) ! pression au milieu de couche (Pa)
70      REAL snow(klon, nbsrf)      REAL, INTENT(inout):: snow(klon, nbsrf)
71      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
72      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
73      REAL albe(klon, nbsrf)      REAL, intent(inout):: falbe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
74    
75      REAL fluxlat(klon, nbsrf)      REAL fluxlat(klon, nbsrf)
76    
77      REAL, intent(in):: rain_fall(klon), snow_f(klon)      REAL, intent(in):: rain_fall(klon)
78        ! liquid water mass flux (kg/m2/s), positive down
79    
80        REAL, intent(in):: snow_f(klon)
81        ! solid water mass flux (kg/m2/s), positive down
82    
83      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)
84      REAL fder(klon)      REAL, intent(in):: fder(klon)
85      REAL, INTENT(IN):: rlon(klon)      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
86    
87      REAL rugos(klon, nbsrf)      REAL, intent(inout):: rugos(klon, nbsrf) ! longueur de rugosit\'e (en m)
     ! rugos----input-R- longeur de rugosite (en m)  
88    
     LOGICAL, INTENT(IN):: debut  
89      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
90      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
91    
# Line 108  contains Line 96  contains
96      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
97      ! changement pour "u" et "v"      ! changement pour "u" et "v"
98    
99      REAL d_ts(klon, nbsrf)      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"
     ! d_ts-----output-R- le changement pour "ts"  
100    
101      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
102      ! 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 110  contains
110      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
111      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
112    
113      REAL dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
114      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
115      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
116      !IM "slab" ocean      ! IM "slab" ocean
117    
118      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
119      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
# Line 134  contains Line 121  contains
121      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)
122      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
123    
124      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
125      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
126      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
127      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
128      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
129      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
130      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
# Line 157  contains Line 144  contains
144      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
145      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
146    
147      REAL flux_o(klon), flux_g(klon)      ! Local:
     !IM "slab" ocean  
     ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')  
     ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')  
   
     REAL tslab(klon)  
     ! tslab-in/output-R temperature du slab ocean (en Kelvin)  
     ! uniqmnt pour slab  
148    
149      REAL seaice(klon)      LOGICAL:: firstcal = .true.
     ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')  
150    
151      ! Local:      ! la nouvelle repartition des surfaces sortie de l'interface
152        REAL, save:: pctsrf_new_oce(klon)
153        REAL, save:: pctsrf_new_sic(klon)
154    
     REAL y_flux_o(klon), y_flux_g(klon)  
     real ytslab(klon)  
     real y_seaice(klon)  
155      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
156      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
157    
# Line 183  contains Line 161  contains
161    
162      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
163      REAL yalb(klon)      REAL yalb(klon)
     REAL yalblw(klon)  
164      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
165      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! on rajoute en output yu1 et yv1 qui sont les vents dans
166      ! la premiere couche      ! la premiere couche
167      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon)
168      REAL yrain_f(klon), ysnow_f(klon)  
169      REAL ysollw(klon), ysolsw(klon)      real yqsol(klon)
170      REAL yfder(klon), ytaux(klon), ytauy(klon)      ! column-density of water in soil, in kg m-2
171    
172        REAL yrain_f(klon)
173        ! liquid water mass flux (kg/m2/s), positive down
174    
175        REAL ysnow_f(klon)
176        ! solid water mass flux (kg/m2/s), positive down
177    
178        REAL yfder(klon)
179      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
180    
181      REAL yfluxlat(klon)      REAL yfluxlat(klon)
# Line 221  contains Line 206  contains
206      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
207    
208      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
209      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
210      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
211    
212      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
   
     ! 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  
213    
214      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
215      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
216    
217      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
218      REAL ypblh(klon)      REAL ypblh(klon)
# Line 278  contains Line 240  contains
240    
241      ytherm = 0.      ytherm = 0.
242    
     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  
   
243      DO k = 1, klev ! epaisseur de couche      DO k = 1, klev ! epaisseur de couche
244         DO i = 1, klon         DO i = 1, klon
245            delp(i, k) = paprs(i, k) - paprs(i, k+1)            delp(i, k) = paprs(i, k) - paprs(i, k+1)
# Line 331  contains Line 264  contains
264      yts = 0.      yts = 0.
265      ysnow = 0.      ysnow = 0.
266      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
267      yrain_f = 0.      yrain_f = 0.
268      ysnow_f = 0.      ysnow_f = 0.
269      yfder = 0.      yfder = 0.
     ytaux = 0.  
     ytauy = 0.  
     ysolsw = 0.  
     ysollw = 0.  
270      yrugos = 0.      yrugos = 0.
271      yu1 = 0.      yu1 = 0.
272      yv1 = 0.      yv1 = 0.
# Line 351  contains Line 278  contains
278      yv = 0.      yv = 0.
279      yt = 0.      yt = 0.
280      yq = 0.      yq = 0.
     pctsrf_new = 0.  
281      y_flux_u = 0.      y_flux_u = 0.
282      y_flux_v = 0.      y_flux_v = 0.
     !$$ PB  
283      y_dflux_t = 0.      y_dflux_t = 0.
284      y_dflux_q = 0.      y_dflux_q = 0.
285      ytsoil = 999999.      ytsoil = 999999.
286      yrugoro = 0.      yrugoro = 0.
     ! -- LOOP  
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
     ! -- LOOP  
287      d_ts = 0.      d_ts = 0.
     !§§§ PB  
288      yfluxlat = 0.      yfluxlat = 0.
289      flux_t = 0.      flux_t = 0.
290      flux_q = 0.      flux_q = 0.
# Line 377  contains Line 296  contains
296      d_v = 0.      d_v = 0.
297      ycoefh = 0.      ycoefh = 0.
298    
299      ! Boucler sur toutes les sous-fractions du sol:      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
300        ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
301      ! 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)  
302    
303      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
304        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
305      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
306      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
307    
308        ! Tester si c'est le moment de lire le fichier:
309        if (mod(itap - 1, lmt_pas) == 0) then
310           CALL interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
311        endif
312    
313        ! Boucler sur toutes les sous-fractions du sol:
314    
315      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
316         ! Chercher les indices :         ! Chercher les indices :
317         ni = 0         ni = 0
318         knon = 0         knon = 0
319         DO i = 1, klon         DO i = 1, klon
320            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
321            ! "potentielles"            ! "potentielles"
322            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
323               knon = knon + 1               knon = knon + 1
# Line 400  contains Line 325  contains
325            END IF            END IF
326         END DO         END DO
327    
        ! 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  
   
328         if_knon: IF (knon /= 0) then         if_knon: IF (knon /= 0) then
329            DO j = 1, knon            DO j = 1, knon
330               i = ni(j)               i = ni(j)
331               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
332               yts(j) = ts(i, nsrf)               yts(j) = ts(i, nsrf)
              ytslab(i) = tslab(i)  
333               ysnow(j) = snow(i, nsrf)               ysnow(j) = snow(i, nsrf)
334               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
335               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
336               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
337               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
338               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
339               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)  
340               yrugos(j) = rugos(i, nsrf)               yrugos(j) = rugos(i, nsrf)
341               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
342               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
343               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
344               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = solsw(i, nsrf) + sollw(i, nsrf)
345               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
346               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))  
347            END DO            END DO
348    
349            ! IF bucket model for continent, copy soil water content            ! For continent, copy soil water content
350            IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN            IF (nsrf == is_ter) THEN
351               DO j = 1, knon               yqsol(:knon) = qsol(ni(:knon))
                 i = ni(j)  
                 yqsol(j) = qsol(i)  
              END DO  
352            ELSE            ELSE
353               yqsol = 0.               yqsol = 0.
354            END IF            END IF
# Line 493  contains Line 394  contains
394                    coefm(:knon, 1), ycoefm0, ycoefh0)                    coefm(:knon, 1), ycoefm0, ycoefh0)
395               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
396               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))               coefh(:knon, :) = max(coefh(:knon, :), ycoefh0(:knon, :))
397             END IF            END IF
398    
399            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
400               ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
401               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
402               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
403                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
404                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 525  contains Line 426  contains
426               END DO               END DO
427    
428               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
429                 IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
430    
431               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  
432    
433               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
434                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
435                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
436                       yustar, iflag_pbl)                       iflag_pbl)
437               ELSE               ELSE
438                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
439                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 551  contains Line 449  contains
449            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
450                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v)
451    
           ! pour le couplage  
           ytaux = y_flux_u(:, 1)  
           ytauy = y_flux_v(:, 1)  
   
452            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
453            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni, pctsrf, &            CALL clqh(dtime, jour, firstcal, rlat, knon, nsrf, ni(:knon), &
454                 soil_model, ytsoil, yqsol, ok_veget, ocean, rmu0, co2_ppm, &                 ytsoil, yqsol, rmu0, yrugos, yrugoro, yu1, yv1, &
455                 yrugos, yrugoro, yu1, yv1, coefh(:knon, :), yt, yq, yts, &                 coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, yrads, &
456                 ypaprs, ypplay, ydelp, yrads, yalb, yalblw, ysnow, yqsurf, &                 yalb(:knon), ysnow, yqsurf, yrain_f, ysnow_f, yfder, yfluxlat, &
457                 yrain_f, ysnow_f, yfder, ysolsw, yfluxlat, pctsrf_new, &                 pctsrf_new_sic, yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), &
458                 yagesno, y_d_t, y_d_q, y_d_ts, yz0_new, y_flux_t, y_flux_q, &                 yz0_new, y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, &
459                 y_dflux_t, y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, &                 y_fqcalving, y_ffonte, y_run_off_lic_0)
                y_flux_o, y_flux_g, ytslab, y_seaice)  
460    
461            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
462            yrugm = 0.            yrugm = 0.
# Line 599  contains Line 492  contains
492    
493            evap(:, nsrf) = -flux_q(:, 1, nsrf)            evap(:, nsrf) = -flux_q(:, 1, nsrf)
494    
495            albe(:, nsrf) = 0.            falbe(:, nsrf) = 0.
           alblw(:, nsrf) = 0.  
496            snow(:, nsrf) = 0.            snow(:, nsrf) = 0.
497            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
498            rugos(:, nsrf) = 0.            rugos(:, nsrf) = 0.
# Line 608  contains Line 500  contains
500            DO j = 1, knon            DO j = 1, knon
501               i = ni(j)               i = ni(j)
502               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
503               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
              alblw(i, nsrf) = yalblw(j)  
504               snow(i, nsrf) = ysnow(j)               snow(i, nsrf) = ysnow(j)
505               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
506               rugos(i, nsrf) = yz0_new(j)               rugos(i, nsrf) = yz0_new(j)
# Line 629  contains Line 520  contains
520               zv1(i) = zv1(i) + yv1(j)               zv1(i) = zv1(i) + yv1(j)
521            END DO            END DO
522            IF (nsrf == is_ter) THEN            IF (nsrf == is_ter) THEN
523               DO j = 1, knon               qsol(ni(:knon)) = yqsol(:knon)
524                  i = ni(j)            else IF (nsrf == is_lic) THEN
                 qsol(i) = yqsol(j)  
              END DO  
           END IF  
           IF (nsrf == is_lic) THEN  
525               DO j = 1, knon               DO j = 1, knon
526                  i = ni(j)                  i = ni(j)
527                  run_off_lic_0(i) = y_run_off_lic_0(j)                  run_off_lic_0(i) = y_run_off_lic_0(j)
528               END DO               END DO
529            END IF            END IF
530            !$$$ PB ajout pour soil  
531            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
532            DO k = 1, nsoilmx            DO k = 1, nsoilmx
533               DO j = 1, knon               DO j = 1, knon
# Line 660  contains Line 547  contains
547               END DO               END DO
548            END DO            END DO
549    
550            !cc diagnostic t, q a 2m et u, v a 10m            ! diagnostic t, q a 2m et u, v a 10m
551    
552            DO j = 1, knon            DO j = 1, knon
553               i = ni(j)               i = ni(j)
# Line 696  contains Line 583  contains
583    
584            END DO            END DO
585    
586            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(knon, ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t, &
587                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q, yu, yv, yt, yq, ypblh(:knon), ycapcl, yoliqcl, &
588                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
589    
590            DO j = 1, knon            DO j = 1, knon
# Line 720  contains Line 607  contains
607                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
608               END DO               END DO
609            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  
610         end IF if_knon         end IF if_knon
611      END DO loop_surface      END DO loop_surface
612    
613      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
   
614      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
615      pctsrf = pctsrf_new      pctsrf(:, is_oce) = pctsrf_new_oce
616        pctsrf(:, is_sic) = pctsrf_new_sic
617    
618        firstcal = .false.
619    
620    END SUBROUTINE clmain    END SUBROUTINE clmain
621    
Legend:
Removed from v.82  
changed lines
  Added in v.202
  ViewVC Help
Powered by ViewVC 1.1.21