/[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

revision 145 by guez, Tue Jun 16 15:23:29 2015 UTC revision 222 by guez, Tue Apr 25 15:31:48 2017 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, jour, rmu0, &    SUBROUTINE clmain(dtime, pctsrf, t, q, u, v, julien, mu0, ftsol, cdmmax, &
8         co2_ppm, ts, cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, &         cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, pplay, fsnow, &
9         paprs, pplay, snow, qsurf, evap, albe, alblw, fluxlat, rain_fall, &         qsurf, evap, falbe, fluxlat, rain_fall, snow_f, fsolsw, fsollw, fder, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         frugs, agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_u, flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         zv1, t2m, q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, run_off_lic_0)
        fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab)  
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
# Line 31  contains Line 30  contains
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
37      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
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      use stdlevvar_m, only: stdlevvar
41      USE suphec_m, ONLY: rd, rg, rkappa      USE suphec_m, ONLY: rd, rg, rkappa
42        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    
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):: julien ! jour de l'annee en cours
56      REAL, intent(in):: rmu0(klon) ! cosinus de l'angle solaire zenithal          REAL, intent(in):: mu0(klon) ! cosinus de l'angle solaire zenithal    
57      REAL, intent(in):: co2_ppm ! taux CO2 atmosphere      REAL, INTENT(IN):: ftsol(:, :) ! (klon, nbsrf) temp\'erature du sol (en K)
     REAL, INTENT(IN):: ts(klon, nbsrf) ! temperature du sol (en Kelvin)  
58      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh      REAL, INTENT(IN):: cdmmax, cdhmax ! seuils cdrm, cdrh
59      REAL, INTENT(IN):: ksta, ksta_ter      REAL, INTENT(IN):: ksta, ksta_ter
60      LOGICAL, INTENT(IN):: ok_kzmin      LOGICAL, INTENT(IN):: ok_kzmin
# Line 70  contains Line 67  contains
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):: fsnow(:, :) ! (klon, nbsrf) \'epaisseur neigeuse
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)
74      REAL alblw(klon, nbsrf)      REAL, intent(out):: fluxlat(:, :) ! (klon, nbsrf)
   
     REAL fluxlat(klon, nbsrf)  
75    
76      REAL, intent(in):: rain_fall(klon)      REAL, intent(in):: rain_fall(klon)
77      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg/m2/s), positive down
# Line 84  contains Line 79  contains
79      REAL, intent(in):: snow_f(klon)      REAL, intent(in):: snow_f(klon)
80      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
81    
82      REAL, INTENT(IN):: solsw(klon, nbsrf), sollw(klon, nbsrf)      REAL, INTENT(IN):: fsolsw(klon, nbsrf), fsollw(klon, nbsrf)
83      REAL fder(klon)      REAL, intent(in):: fder(:) ! (klon)
84      REAL, INTENT(IN):: rlat(klon) ! latitude en degr\'es      REAL, intent(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
85      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
86      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
87    
# Line 102  contains Line 92  contains
92      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
93      ! changement pour "u" et "v"      ! changement pour "u" et "v"
94    
95      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
96    
97        REAL, intent(out):: flux_t(klon, nbsrf)
98        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
99        ! le bas) à la surface
100    
101        REAL, intent(out):: flux_q(klon, nbsrf)
102        ! flux de vapeur d'eau (kg/m2/s) à la surface
103    
104      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
105      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! tension du vent à la surface, en Pa
     !                    (orientation positive vers le bas)  
     ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)  
   
     REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)  
     ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal  
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
106    
107      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
108      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 119  contains Line 110  contains
110      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
111      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
112      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
113      !IM "slab" ocean      ! IM "slab" ocean
114    
115      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
116      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
117      REAL zv1(klon)      REAL zv1(klon)
118      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
119      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
120    
121      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
122      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
123      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
124      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
125      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
126      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
127      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
128      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
129      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
130      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
131      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 150  contains Line 140  contains
140      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
141      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
142    
     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  
   
143      ! Local:      ! Local:
144    
145      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
146      real ytslab(klon)  
147        ! la nouvelle repartition des surfaces sortie de l'interface
148        REAL, save:: pctsrf_new_oce(klon)
149        REAL, save:: pctsrf_new_sic(klon)
150    
151      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
152      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
153      REAL rugmer(klon)      REAL rugmer(klon)
   
154      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
155      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
156      REAL yalb(klon)      REAL yalb(klon)
157      REAL yalblw(klon)  
158      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
159      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
160      ! la premiere couche      ! la premi\`ere couche.
161      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
162        REAL snow(klon), yqsurf(klon), yagesno(klon)
163    
164      real yqsol(klon)      real yqsol(klon)
165      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 187  contains Line 170  contains
170      REAL ysnow_f(klon)      REAL ysnow_f(klon)
171      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
172    
     REAL ysollw(klon), ysolsw(klon)  
173      REAL yfder(klon)      REAL yfder(klon)
174      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
175      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
176      REAL y_d_ts(klon)      REAL y_d_ts(klon)
177      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
178      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
179      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
180      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
181      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
182      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
183      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 222  contains Line 202  contains
202      ! "pourcentage potentiel" pour tenir compte des \'eventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
203      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
204    
205      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
206    
207      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
208      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
209    
210      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
211      REAL ypblh(klon)      REAL ypblh(klon)
# Line 279  contains Line 254  contains
254      zu1 = 0.      zu1 = 0.
255      zv1 = 0.      zv1 = 0.
256      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
257      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
258      yrain_f = 0.      yrain_f = 0.
259      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ysolsw = 0.  
     ysollw = 0.  
260      yrugos = 0.      yrugos = 0.
261      yu1 = 0.      yu1 = 0.
262      yv1 = 0.      yv1 = 0.
     yrads = 0.  
263      ypaprs = 0.      ypaprs = 0.
264      ypplay = 0.      ypplay = 0.
265      ydelp = 0.      ydelp = 0.
# Line 300  contains Line 267  contains
267      yv = 0.      yv = 0.
268      yt = 0.      yt = 0.
269      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
270      y_dflux_t = 0.      y_dflux_t = 0.
271      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
272      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
273      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
274      flux_t = 0.      flux_t = 0.
275      flux_q = 0.      flux_q = 0.
276      flux_u = 0.      flux_u = 0.
277      flux_v = 0.      flux_v = 0.
278        fluxlat = 0.
279      d_t = 0.      d_t = 0.
280      d_q = 0.      d_q = 0.
281      d_u = 0.      d_u = 0.
# Line 326  contains Line 286  contains
286      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
287      ! (\`a affiner)      ! (\`a affiner)
288    
289      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
290        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
291      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
292      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
293    
294        ! Tester si c'est le moment de lire le fichier:
295        if (mod(itap - 1, lmt_pas) == 0) then
296           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
297        endif
298    
299      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
300    
301      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 349  contains Line 315  contains
315            DO j = 1, knon            DO j = 1, knon
316               i = ni(j)               i = ni(j)
317               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
318               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
319               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
320               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
321               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
322               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
323               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
324               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
325               yfder(j) = fder(i)               yfder(j) = fder(i)
326               ysolsw(j) = solsw(i, nsrf)               yrugos(j) = frugs(i, nsrf)
              ysollw(j) = sollw(i, nsrf)  
              yrugos(j) = rugos(i, nsrf)  
327               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
328               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
329               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
330               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
331               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
332               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))  
333            END DO            END DO
334    
335            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 380  contains Line 339  contains
339               yqsol = 0.               yqsol = 0.
340            END IF            END IF
341    
342            DO k = 1, nsoilmx            ytsoil(:knon, :) = ftsoil(ni(:knon), :, nsrf)
              DO j = 1, knon  
                 i = ni(j)  
                 ytsoil(j, k) = ftsoil(i, k, nsrf)  
              END DO  
           END DO  
343    
344            DO k = 1, klev            DO k = 1, klev
345               DO j = 1, knon               DO j = 1, knon
# Line 401  contains Line 355  contains
355            END DO            END DO
356    
357            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
358            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
359                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
360                   coefh(:knon, :))
361            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
362               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
363               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 472  contains Line 427  contains
427    
428            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
429            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
430                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
431            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
432                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
433    
434            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
435            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
436                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
437                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
438                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
439                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 ysnow_f, yfder(:knon), yfluxlat(:knon), pctsrf_new_sic, &
440                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 yagesno(:knon), y_d_t, y_d_q, y_d_ts(:knon), yz0_new, &
441                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 y_flux_t(:knon), y_flux_q(:knon), y_dflux_t(:knon), &
442                 y_flux_g)                 y_dflux_q(:knon), y_fqcalving, y_ffonte, y_run_off_lic_0)
443    
444            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
445            yrugm = 0.            yrugm = 0.
# Line 509  contains Line 464  contains
464                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
465                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
466                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)                  y_d_q(j, k) = y_d_q(j, k)*ypct(j)
                 flux_t(i, k, nsrf) = y_flux_t(j, k)  
                 flux_q(i, k, nsrf) = y_flux_q(j, k)  
                 flux_u(i, k, nsrf) = y_flux_u(j, k)  
                 flux_v(i, k, nsrf) = y_flux_v(j, k)  
467                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
468                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
469               END DO               END DO
470            END DO            END DO
471    
472            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
473              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
474              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
475              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
476    
477            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
478            alblw(:, nsrf) = 0.  
479            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
480              fsnow(:, nsrf) = 0.
481            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
482            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
483            DO j = 1, knon            DO j = 1, knon
484               i = ni(j)               i = ni(j)
485               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
486               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
487               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
488               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
489               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
490               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
491               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
492                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
493                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
494               END IF               END IF
495               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
496               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 559  contains Line 512  contains
512            END IF            END IF
513    
514            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
515            DO k = 1, nsoilmx            ftsoil(ni(:knon), :, nsrf) = ytsoil(:knon, :)
              DO j = 1, knon  
                 i = ni(j)  
                 ftsoil(i, k, nsrf) = ytsoil(j, k)  
              END DO  
           END DO  
516    
517            DO j = 1, knon            DO j = 1, knon
518               i = ni(j)               i = ni(j)
# Line 590  contains Line 538  contains
538               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
539               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
540               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
541                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
542               END IF               END IF
543               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
544               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 610  contains Line 558  contains
558               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
559               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)               u10m(i, nsrf) = (yu10m(j)*uzon(j))/sqrt(uzon(j)**2+vmer(j)**2)
560               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)               v10m(i, nsrf) = (yu10m(j)*vmer(j))/sqrt(uzon(j)**2+vmer(j)**2)
   
561            END DO            END DO
562    
563            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
564                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
565                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
566    
567            DO j = 1, knon            DO j = 1, knon
568               i = ni(j)               i = ni(j)
# Line 637  contains Line 584  contains
584                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
585               END DO               END DO
586            END DO            END DO
587            !IM "slab" ocean         else
588            IF (nsrf == is_oce) THEN            fsnow(:, nsrf) = 0.
              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\`ere 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  
589         end IF if_knon         end IF if_knon
590      END DO loop_surface      END DO loop_surface
591    
592      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
593        frugs(:, is_oce) = rugmer
594        pctsrf(:, is_oce) = pctsrf_new_oce
595        pctsrf(:, is_sic) = pctsrf_new_sic
596    
597      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
598    
599    END SUBROUTINE clmain    END SUBROUTINE clmain
600    
Legend:
Removed from v.145  
changed lines
  Added in v.222
  ViewVC Help
Powered by ViewVC 1.1.21