/[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 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 223 by guez, Fri Apr 28 13:22:36 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, frugs, &
10         snow_f, solsw, sollw, fder, rlat, rugos, debut, agesno, rugoro, d_t, &         agesno, rugoro, d_t, d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, &
11         d_q, d_u, d_v, d_ts, flux_t, flux_q, flux_u, flux_v, cdragh, cdragm, &         flux_v, cdragh, cdragm, q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, &
12         q2, dflux_t, dflux_q, ycoefh, zu1, zv1, t2m, q2m, u10m, v10m, pblh, &         q2m, u10m, v10m, pblh, capcl, oliqcl, cteicl, pblt, therm, trmb1, &
13         capcl, oliqcl, cteicl, pblt, therm, trmb1, trmb2, trmb3, plcl, &         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 19  contains Line 18  contains
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    
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
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(inout):: frugs(klon, nbsrf) ! longueur de rugosit\'e (en m)
     REAL, INTENT(IN):: rlat(klon) ! latitude en degrés  
   
     REAL rugos(klon, nbsrf)  
     ! rugos----input-R- longeur de rugosite (en m)  
   
     LOGICAL, INTENT(IN):: debut  
84      real agesno(klon, nbsrf)      real agesno(klon, nbsrf)
85      REAL, INTENT(IN):: rugoro(klon)      REAL, INTENT(IN):: rugoro(klon)
86    
# Line 102  contains Line 91  contains
91      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
92      ! changement pour "u" et "v"      ! changement pour "u" et "v"
93    
94      REAL, intent(out):: d_ts(klon, nbsrf) ! le changement pour "ts"      REAL, intent(out):: d_ts(:, :) ! (klon, nbsrf) variation of ftsol
95    
96        REAL, intent(out):: flux_t(klon, nbsrf)
97        ! flux de chaleur sensible (Cp T) (W/m2) (orientation positive vers
98        ! le bas) à la surface
99    
100        REAL, intent(out):: flux_q(klon, nbsrf)
101        ! flux de vapeur d'eau (kg/m2/s) à la surface
102    
103      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)      REAL, intent(out):: flux_u(klon, nbsrf), flux_v(klon, nbsrf)
104      ! 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  
105    
106      REAL, INTENT(out):: cdragh(klon), cdragm(klon)      REAL, INTENT(out):: cdragh(klon), cdragm(klon)
107      real q2(klon, klev+1, nbsrf)      real q2(klon, klev+1, nbsrf)
# Line 119  contains Line 109  contains
109      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)      REAL, INTENT(out):: dflux_t(klon), dflux_q(klon)
110      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
111      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
112      !IM "slab" ocean      ! IM "slab" ocean
113    
114      REAL, intent(out):: ycoefh(klon, klev)      REAL, intent(out):: ycoefh(klon, klev)
115      REAL, intent(out):: zu1(klon)      REAL, intent(out):: zu1(klon)
116      REAL zv1(klon)      REAL zv1(klon)
117      REAL t2m(klon, nbsrf), q2m(klon, nbsrf)      REAL, INTENT(inout):: t2m(klon, nbsrf), q2m(klon, nbsrf)
118      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)      REAL u10m(klon, nbsrf), v10m(klon, nbsrf)
119    
120      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      ! Ionela Musat cf. Anne Mathieu : planetary boundary layer, hbtm
121      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! (Comme les autres diagnostics on cumule dans physiq ce qui
122      REAL pblh(klon, nbsrf)      ! permet de sortir les grandeurs par sous-surface)
123      ! pblh------- HCL      REAL pblh(klon, nbsrf) ! height of planetary boundary layer
124      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
125      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
126      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
127      REAL pblt(klon, nbsrf)      REAL, INTENT(inout):: pblt(klon, nbsrf) ! T au nveau HCL
     ! pblT------- T au nveau HCL  
128      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
129      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
130      ! trmb1-------deep_cape      ! trmb1-------deep_cape
# Line 150  contains Line 139  contains
139      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
140      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
141    
     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  
   
142      ! Local:      ! Local:
143    
144      REAL y_flux_o(klon), y_flux_g(klon)      LOGICAL:: firstcal = .true.
145      real ytslab(klon)  
146        ! la nouvelle repartition des surfaces sortie de l'interface
147        REAL, save:: pctsrf_new_oce(klon)
148        REAL, save:: pctsrf_new_sic(klon)
149    
150      REAL y_fqcalving(klon), y_ffonte(klon)      REAL y_fqcalving(klon), y_ffonte(klon)
151      real y_run_off_lic_0(klon)      real y_run_off_lic_0(klon)
   
152      REAL rugmer(klon)      REAL rugmer(klon)
   
153      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
   
154      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
155      REAL yalb(klon)      REAL yalb(klon)
156      REAL yalblw(klon)  
157      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
158      ! on rajoute en output yu1 et yv1 qui sont les vents dans      ! On ajoute en output yu1 et yv1 qui sont les vents dans
159      ! la premiere couche      ! la premi\`ere couche.
160      REAL ysnow(klon), yqsurf(klon), yagesno(klon)      
161        REAL snow(klon), yqsurf(klon), yagesno(klon)
162    
163      real yqsol(klon)      real yqsol(klon)
164      ! column-density of water in soil, in kg m-2      ! column-density of water in soil, in kg m-2
# Line 187  contains Line 169  contains
169      REAL ysnow_f(klon)      REAL ysnow_f(klon)
170      ! solid water mass flux (kg/m2/s), positive down      ! solid water mass flux (kg/m2/s), positive down
171    
     REAL ysollw(klon), ysolsw(klon)  
     REAL yfder(klon)  
172      REAL yrugm(klon), yrads(klon), yrugoro(klon)      REAL yrugm(klon), yrads(klon), yrugoro(klon)
   
173      REAL yfluxlat(klon)      REAL yfluxlat(klon)
   
174      REAL y_d_ts(klon)      REAL y_d_ts(klon)
175      REAL y_d_t(klon, klev), y_d_q(klon, klev)      REAL y_d_t(klon, klev), y_d_q(klon, klev)
176      REAL y_d_u(klon, klev), y_d_v(klon, klev)      REAL y_d_u(klon, klev), y_d_v(klon, klev)
177      REAL y_flux_t(klon, klev), y_flux_q(klon, klev)      REAL y_flux_t(klon), y_flux_q(klon)
178      REAL y_flux_u(klon, klev), y_flux_v(klon, klev)      REAL y_flux_u(klon), y_flux_v(klon)
179      REAL y_dflux_t(klon), y_dflux_q(klon)      REAL y_dflux_t(klon), y_dflux_q(klon)
180      REAL coefh(klon, klev), coefm(klon, klev)      REAL coefh(klon, klev), coefm(klon, klev)
181      REAL yu(klon, klev), yv(klon, klev)      REAL yu(klon, klev), yv(klon, klev)
# Line 219  contains Line 197  contains
197      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
198    
199      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
200      ! "pourcentage potentiel" pour tenir compte des éventuelles      ! "pourcentage potentiel" pour tenir compte des \'eventuelles
201      ! apparitions ou disparitions de la glace de mer      ! apparitions ou disparitions de la glace de mer
202    
203      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 ! valeur ambiante par extrapolation
204    
205      REAL yt2m(klon), yq2m(klon), yu10m(klon)      REAL yt2m(klon), yq2m(klon), yu10m(klon)
206      REAL yustar(klon)      REAL yustar(klon)
     ! -- LOOP  
     REAL yu10mx(klon)  
     REAL yu10my(klon)  
     REAL ywindsp(klon)  
     ! -- LOOP  
207    
208      REAL yt10m(klon), yq10m(klon)      REAL yt10m(klon), yq10m(klon)
209      REAL ypblh(klon)      REAL ypblh(klon)
# Line 279  contains Line 252  contains
252      zu1 = 0.      zu1 = 0.
253      zv1 = 0.      zv1 = 0.
254      ypct = 0.      ypct = 0.
     yts = 0.  
     ysnow = 0.  
255      yqsurf = 0.      yqsurf = 0.
     yalb = 0.  
     yalblw = 0.  
256      yrain_f = 0.      yrain_f = 0.
257      ysnow_f = 0.      ysnow_f = 0.
     yfder = 0.  
     ysolsw = 0.  
     ysollw = 0.  
258      yrugos = 0.      yrugos = 0.
259      yu1 = 0.      yu1 = 0.
260      yv1 = 0.      yv1 = 0.
     yrads = 0.  
261      ypaprs = 0.      ypaprs = 0.
262      ypplay = 0.      ypplay = 0.
263      ydelp = 0.      ydelp = 0.
# Line 300  contains Line 265  contains
265      yv = 0.      yv = 0.
266      yt = 0.      yt = 0.
267      yq = 0.      yq = 0.
     pctsrf_new = 0.  
     y_flux_u = 0.  
     y_flux_v = 0.  
268      y_dflux_t = 0.      y_dflux_t = 0.
269      y_dflux_q = 0.      y_dflux_q = 0.
     ytsoil = 999999.  
270      yrugoro = 0.      yrugoro = 0.
     yu10mx = 0.  
     yu10my = 0.  
     ywindsp = 0.  
271      d_ts = 0.      d_ts = 0.
     yfluxlat = 0.  
272      flux_t = 0.      flux_t = 0.
273      flux_q = 0.      flux_q = 0.
274      flux_u = 0.      flux_u = 0.
275      flux_v = 0.      flux_v = 0.
276        fluxlat = 0.
277      d_t = 0.      d_t = 0.
278      d_q = 0.      d_q = 0.
279      d_u = 0.      d_u = 0.
280      d_v = 0.      d_v = 0.
281      ycoefh = 0.      ycoefh = 0.
282    
283      ! Initialisation des "pourcentages potentiels". On considère ici qu'on      ! Initialisation des "pourcentages potentiels". On consid\`ere ici qu'on
284      ! peut avoir potentiellement de la glace sur tout le domaine océanique      ! peut avoir potentiellement de la glace sur tout le domaine oc\'eanique
285      ! (à affiner)      ! (\`a affiner)
286    
287      pctsrf_pot = pctsrf      pctsrf_pot(:, is_ter) = pctsrf(:, is_ter)
288        pctsrf_pot(:, is_lic) = pctsrf(:, is_lic)
289      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
290      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
291    
292        ! Tester si c'est le moment de lire le fichier:
293        if (mod(itap - 1, lmt_pas) == 0) then
294           CALL interfoce_lim(julien, pctsrf_new_oce, pctsrf_new_sic)
295        endif
296    
297      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
298    
299      loop_surface: DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
# Line 337  contains Line 301  contains
301         ni = 0         ni = 0
302         knon = 0         knon = 0
303         DO i = 1, klon         DO i = 1, klon
304            ! Pour déterminer le domaine à traiter, on utilise les surfaces            ! Pour d\'eterminer le domaine \`a traiter, on utilise les surfaces
305            ! "potentielles"            ! "potentielles"
306            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
307               knon = knon + 1               knon = knon + 1
# Line 349  contains Line 313  contains
313            DO j = 1, knon            DO j = 1, knon
314               i = ni(j)               i = ni(j)
315               ypct(j) = pctsrf(i, nsrf)               ypct(j) = pctsrf(i, nsrf)
316               yts(j) = ts(i, nsrf)               yts(j) = ftsol(i, nsrf)
317               ytslab(i) = tslab(i)               snow(j) = fsnow(i, nsrf)
              ysnow(j) = snow(i, nsrf)  
318               yqsurf(j) = qsurf(i, nsrf)               yqsurf(j) = qsurf(i, nsrf)
319               yalb(j) = albe(i, nsrf)               yalb(j) = falbe(i, nsrf)
              yalblw(j) = alblw(i, nsrf)  
320               yrain_f(j) = rain_fall(i)               yrain_f(j) = rain_fall(i)
321               ysnow_f(j) = snow_f(i)               ysnow_f(j) = snow_f(i)
322               yagesno(j) = agesno(i, nsrf)               yagesno(j) = agesno(i, nsrf)
323               yfder(j) = fder(i)               yrugos(j) = frugs(i, nsrf)
              ysolsw(j) = solsw(i, nsrf)  
              ysollw(j) = sollw(i, nsrf)  
              yrugos(j) = rugos(i, nsrf)  
324               yrugoro(j) = rugoro(i)               yrugoro(j) = rugoro(i)
325               yu1(j) = u1lay(i)               yu1(j) = u1lay(i)
326               yv1(j) = v1lay(i)               yv1(j) = v1lay(i)
327               yrads(j) = ysolsw(j) + ysollw(j)               yrads(j) = fsolsw(i, nsrf) + fsollw(i, nsrf)
328               ypaprs(j, klev+1) = paprs(i, klev+1)               ypaprs(j, klev+1) = paprs(i, klev+1)
329               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))  
330            END DO            END DO
331    
332            ! For continent, copy soil water content            ! For continent, copy soil water content
# Line 380  contains Line 336  contains
336               yqsol = 0.               yqsol = 0.
337            END IF            END IF
338    
339            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  
340    
341            DO k = 1, klev            DO k = 1, klev
342               DO j = 1, knon               DO j = 1, knon
# Line 401  contains Line 352  contains
352            END DO            END DO
353    
354            ! calculer Cdrag et les coefficients d'echange            ! calculer Cdrag et les coefficients d'echange
355            CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts, yrugos, &            CALL coefkz(nsrf, ypaprs, ypplay, ksta, ksta_ter, yts(:knon), &
356                 yu, yv, yt, yq, yqsurf, coefm(:knon, :), coefh(:knon, :))                 yrugos, yu, yv, yt, yq, yqsurf(:knon), coefm(:knon, :), &
357                   coefh(:knon, :))
358            IF (iflag_pbl == 1) THEN            IF (iflag_pbl == 1) THEN
359               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)               CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
360               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))               coefm(:knon, :) = max(coefm(:knon, :), ycoefm0(:knon, :))
# Line 424  contains Line 376  contains
376            END IF            END IF
377    
378            IF (iflag_pbl >= 3) THEN            IF (iflag_pbl >= 3) THEN
379               ! Mellor et Yamada adapté à Mars, Richard Fournier et               ! Mellor et Yamada adapt\'e \`a Mars, Richard Fournier et
380               ! Frédéric Hourdin               ! Fr\'ed\'eric Hourdin
381               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &               yzlay(:knon, 1) = rd * yt(:knon, 1) / (0.5 * (ypaprs(:knon, 1) &
382                    + ypplay(:knon, 1))) &                    + ypplay(:knon, 1))) &
383                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg                    * (ypaprs(:knon, 1) - ypplay(:knon, 1)) / rg
# Line 455  contains Line 407  contains
407               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)               CALL ustarhb(knon, yu, yv, coefm(:knon, 1), yustar)
408               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar               IF (prt_level > 9) PRINT *, 'USTAR = ', yustar
409    
410               ! iflag_pbl peut être utilisé comme longueur de mélange               ! iflag_pbl peut \^etre utilis\'e comme longueur de m\'elange
411    
412               IF (iflag_pbl >= 11) THEN               IF (iflag_pbl >= 11) THEN
413                  CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &                  CALL vdif_kcay(knon, dtime, rg, ypaprs, yzlev, yzlay, yu, yv, &
414                       yu, yv, yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, &                       yteta, coefm(:knon, 1), yq2, q2diag, ykmm, ykmn, yustar, &
415                       yustar, iflag_pbl)                       iflag_pbl)
416               ELSE               ELSE
417                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &                  CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
418                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                       coefm(:knon, 1), yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
# Line 472  contains Line 424  contains
424    
425            ! calculer la diffusion des vitesses "u" et "v"            ! calculer la diffusion des vitesses "u" et "v"
426            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yu, ypaprs, &
427                 ypplay, ydelp, y_d_u, y_flux_u)                 ypplay, ydelp, y_d_u, y_flux_u(:knon))
428            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &            CALL clvent(knon, dtime, yu1, yv1, coefm(:knon, :), yt, yv, ypaprs, &
429                 ypplay, ydelp, y_d_v, y_flux_v)                 ypplay, ydelp, y_d_v, y_flux_v(:knon))
430    
431            ! calculer la diffusion de "q" et de "h"            ! calculer la diffusion de "q" et de "h"
432            CALL clqh(dtime, itap, jour, debut, rlat, knon, nsrf, ni(:knon), &            CALL clqh(dtime, julien, firstcal, nsrf, ni(:knon), &
433                 pctsrf, ytsoil, yqsol, rmu0, co2_ppm, yrugos, yrugoro, yu1, &                 ytsoil(:knon, :), yqsol, mu0, yrugos, yrugoro, yu1, yv1, &
434                 yv1, coefh(:knon, :), yt, yq, yts, ypaprs, ypplay, ydelp, &                 coefh(:knon, :), yt, yq, yts(:knon), ypaprs, ypplay, ydelp, &
435                 yrads, yalb, yalblw, ysnow, yqsurf, yrain_f, ysnow_f, yfder, &                 yrads(:knon), yalb(:knon), snow(:knon), yqsurf, yrain_f, &
436                 ysolsw, yfluxlat, pctsrf_new, yagesno, y_d_t, y_d_q, &                 ysnow_f, yfluxlat(:knon), pctsrf_new_sic, yagesno(:knon), &
437                 y_d_ts(:knon), yz0_new, y_flux_t, y_flux_q, y_dflux_t, &                 y_d_t, y_d_q, y_d_ts(:knon), yz0_new, y_flux_t(:knon), &
438                 y_dflux_q, y_fqcalving, y_ffonte, y_run_off_lic_0, y_flux_o, &                 y_flux_q(:knon), y_dflux_t(:knon), y_dflux_q(:knon), &
439                 y_flux_g)                 y_fqcalving, y_ffonte, y_run_off_lic_0)
440    
441            ! calculer la longueur de rugosite sur ocean            ! calculer la longueur de rugosite sur ocean
442            yrugm = 0.            yrugm = 0.
# Line 509  contains Line 461  contains
461                  coefm(j, k) = coefm(j, k)*ypct(j)                  coefm(j, k) = coefm(j, k)*ypct(j)
462                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)                  y_d_t(j, k) = y_d_t(j, k)*ypct(j)
463                  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)  
464                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)                  y_d_u(j, k) = y_d_u(j, k)*ypct(j)
465                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)                  y_d_v(j, k) = y_d_v(j, k)*ypct(j)
466               END DO               END DO
467            END DO            END DO
468    
469            evap(:, nsrf) = -flux_q(:, 1, nsrf)            flux_t(ni(:knon), nsrf) = y_flux_t(:knon)
470              flux_q(ni(:knon), nsrf) = y_flux_q(:knon)
471              flux_u(ni(:knon), nsrf) = y_flux_u(:knon)
472              flux_v(ni(:knon), nsrf) = y_flux_v(:knon)
473    
474            albe(:, nsrf) = 0.            evap(:, nsrf) = -flux_q(:, nsrf)
475            alblw(:, nsrf) = 0.  
476            snow(:, nsrf) = 0.            falbe(:, nsrf) = 0.
477              fsnow(:, nsrf) = 0.
478            qsurf(:, nsrf) = 0.            qsurf(:, nsrf) = 0.
479            rugos(:, nsrf) = 0.            frugs(:, nsrf) = 0.
           fluxlat(:, nsrf) = 0.  
480            DO j = 1, knon            DO j = 1, knon
481               i = ni(j)               i = ni(j)
482               d_ts(i, nsrf) = y_d_ts(j)               d_ts(i, nsrf) = y_d_ts(j)
483               albe(i, nsrf) = yalb(j)               falbe(i, nsrf) = yalb(j)
484               alblw(i, nsrf) = yalblw(j)               fsnow(i, nsrf) = snow(j)
              snow(i, nsrf) = ysnow(j)  
485               qsurf(i, nsrf) = yqsurf(j)               qsurf(i, nsrf) = yqsurf(j)
486               rugos(i, nsrf) = yz0_new(j)               frugs(i, nsrf) = yz0_new(j)
487               fluxlat(i, nsrf) = yfluxlat(j)               fluxlat(i, nsrf) = yfluxlat(j)
488               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
489                  rugmer(i) = yrugm(j)                  rugmer(i) = yrugm(j)
490                  rugos(i, nsrf) = yrugm(j)                  frugs(i, nsrf) = yrugm(j)
491               END IF               END IF
492               agesno(i, nsrf) = yagesno(j)               agesno(i, nsrf) = yagesno(j)
493               fqcalving(i, nsrf) = y_fqcalving(j)               fqcalving(i, nsrf) = y_fqcalving(j)
# Line 559  contains Line 509  contains
509            END IF            END IF
510    
511            ftsoil(:, :, nsrf) = 0.            ftsoil(:, :, nsrf) = 0.
512            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  
513    
514            DO j = 1, knon            DO j = 1, knon
515               i = ni(j)               i = ni(j)
# Line 590  contains Line 535  contains
535               tairsol(j) = yts(j) + y_d_ts(j)               tairsol(j) = yts(j) + y_d_ts(j)
536               rugo1(j) = yrugos(j)               rugo1(j) = yrugos(j)
537               IF (nsrf == is_oce) THEN               IF (nsrf == is_oce) THEN
538                  rugo1(j) = rugos(i, nsrf)                  rugo1(j) = frugs(i, nsrf)
539               END IF               END IF
540               psfce(j) = ypaprs(j, 1)               psfce(j) = ypaprs(j, 1)
541               patm(j) = ypplay(j, 1)               patm(j) = ypplay(j, 1)
# Line 610  contains Line 555  contains
555               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman               ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
556               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)
557               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)
   
558            END DO            END DO
559    
560            CALL hbtm(knon, ypaprs, ypplay, yt2m, yt10m, yq2m, yq10m, yustar, &            CALL hbtm(ypaprs, ypplay, yt2m, yq2m, yustar, y_flux_t(:knon), &
561                 y_flux_t, y_flux_q, yu, yv, yt, yq, ypblh, ycapcl, yoliqcl, &                 y_flux_q(:knon), yu, yv, yt, yq, ypblh(:knon), ycapcl, &
562                 ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)                 yoliqcl, ycteicl, ypblt, ytherm, ytrmb1, ytrmb2, ytrmb3, ylcl)
563    
564            DO j = 1, knon            DO j = 1, knon
565               i = ni(j)               i = ni(j)
# Line 637  contains Line 581  contains
581                  q2(i, k, nsrf) = yq2(j, k)                  q2(i, k, nsrf) = yq2(j, k)
582               END DO               END DO
583            END DO            END DO
584            !IM "slab" ocean         else
585            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è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  
586         end IF if_knon         end IF if_knon
587      END DO loop_surface      END DO loop_surface
588    
589      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
590        frugs(:, is_oce) = rugmer
591        pctsrf(:, is_oce) = pctsrf_new_oce
592        pctsrf(:, is_sic) = pctsrf_new_sic
593    
594      rugos(:, is_oce) = rugmer      firstcal = .false.
     pctsrf = pctsrf_new  
595    
596    END SUBROUTINE clmain    END SUBROUTINE clmain
597    
Legend:
Removed from v.134  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.21